[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Change Ord defaults per CLC proposal
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Sep 5 21:30:08 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
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.
- - - - -
7352946e by Sebastian Graf at 2022-09-05T17:29:47-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.
- - - - -
7bd21f2e by Ben Gamari at 2022-09-05T17:29:48-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`.
- - - - -
8 changed files:
- .gitlab-ci.yml
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- docs/users_guide/9.6.1-notes.rst
- libraries/base/changelog.md
- libraries/ghc-prim/GHC/Classes.hs
- + testsuite/tests/stranal/should_compile/T22039.hs
- testsuite/tests/stranal/should_compile/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -267,7 +267,7 @@ lint-ci-config:
- mkdir -p ~/.cabal
- cp -Rf cabal-cache/* ~/.cabal || true
script:
- - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#cabal-install -c cabal update
+ - nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#cabal-install nixpkgs#ghc -c cabal update
- .gitlab/generate_jobs
# 1 if .gitlab/generate_jobs changed the output of the generated config
- nix shell --extra-experimental-features nix-command --extra-experimental-features flakes nixpkgs#git -c git diff --exit-code
=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -455,8 +455,9 @@ dmdAnal' env dmd (Case scrut case_bndr ty [Alt alt_con bndrs rhs])
!(!bndrs', !scrut_sd)
| DataAlt _ <- alt_con
-- See Note [Demand on the scrutinee of a product case]
+ , let !scrut_sd = scrutSubDmd case_bndr_sd fld_dmds
-- See Note [Demand on case-alternative binders]
- , (!scrut_sd, fld_dmds') <- addCaseBndrDmd case_bndr_sd fld_dmds
+ , let !fld_dmds' = fieldBndrDmds scrut_sd (length fld_dmds)
, let !bndrs' = setBndrsDemandInfo bndrs fld_dmds'
= (bndrs', scrut_sd)
| otherwise
@@ -560,7 +561,6 @@ forcesRealWorld fam_envs ty
= False
dmdAnalSumAlts :: AnalEnv -> SubDemand -> Id -> [CoreAlt] -> WithDmdType [CoreAlt]
-
dmdAnalSumAlts _ _ _ [] = WithDmdType botDmdType []
-- Base case is botDmdType, for empty case alternatives
-- This is a unit for lubDmdType, and the right result
@@ -580,28 +580,29 @@ dmdAnalSumAlt env dmd case_bndr (Alt con bndrs rhs)
-- See Note [Demand on case-alternative binders]
-- we can't use the scrut_sd, because it says 'Prod' and we'll use
-- topSubDmd anyway for scrutinees of sum types.
- (!_scrut_sd, dmds') = addCaseBndrDmd case_bndr_sd dmds
+ scrut_sd = scrutSubDmd case_bndr_sd dmds
+ dmds' = fieldBndrDmds scrut_sd (length dmds)
-- Do not put a thunk into the Alt
!new_ids = setBndrsDemandInfo bndrs dmds'
= -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $
WithDmdType alt_ty (Alt con new_ids rhs')
--- Precondition: The SubDemand is not a Call
-- See Note [Demand on the scrutinee of a product case]
--- and Note [Demand on case-alternative binders]
-addCaseBndrDmd :: SubDemand -- On the case binder
- -> [Demand] -- On the fields of the constructor
- -> (SubDemand, [Demand])
- -- SubDemand on the case binder incl. field demands
- -- and final demands for the components of the constructor
-addCaseBndrDmd case_sd fld_dmds
- | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd
- -- , pprTrace "addCaseBndrDmd" (ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) True
- = (scrut_sd, ds)
- | otherwise
- = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition
- where
- scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds
+scrutSubDmd :: SubDemand -> [Demand] -> SubDemand
+scrutSubDmd case_sd fld_dmds =
+ -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $
+ case_sd `plusSubDmd` mkProd Unboxed fld_dmds
+
+-- See Note [Demand on case-alternative binders]
+fieldBndrDmds :: SubDemand -- on the scrutinee
+ -> Arity
+ -> [Demand] -- Final demands for the components of the DataCon
+fieldBndrDmds scrut_sd n_flds =
+ case viewProd n_flds scrut_sd of
+ Just (_, ds) -> ds
+ Nothing -> replicate n_flds topDmd
+ -- Either an arity mismatch or scrut_sd was a call demand.
+ -- See Note [Untyped demand on case-alternative binders]
{-
Note [Anticipating ANF in demand analysis]
@@ -830,6 +831,44 @@ thunk for a let binder that was an an absent case-alt binder during DmdAnal.
This is needed even for non-product types, in case the case-binder
is used but the components of the case alternative are not.
+Note [Untyped demand on case-alternative binders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder
+may be a call demand or have a different number of fields than the constructor
+of the case alternative it is used in. From T22039:
+
+ blarg :: (Int, Int) -> Int
+ blarg (x,y) = x+y
+ -- blarg :: <1!P(1L,1L)>
+
+ f :: Either Int Int -> Int
+ f Left{} = 0
+ f e = blarg (unsafeCoerce e)
+ ==> { desugars to }
+ f = \ (ds_d1nV :: Either Int Int) ->
+ case ds_d1nV of wild_X1 {
+ Left ds_d1oV -> lvl_s1Q6;
+ Right ipv_s1Pl ->
+ blarg
+ (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of
+ { UnsafeRefl co_a1oT ->
+ wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int))
+ })
+ }
+
+The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call
+to `blarg`, but `Right` only has one field. Although the code will crash when
+executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively
+approximate with Top instead of panicking because of the mismatch.
+In #22039, this kind of code was guarded behind a safe `cast` and thus dead
+code, but nevertheless led to a panic of the compiler.
+
+You might wonder why the same problem doesn't come up when scrutinising a
+product type instead of a sum type. It appears that for products, `wild_X1`
+will be inlined before DmdAnal.
+
+See also Note [mkWWstr and unsafeCoerce] for a related issue.
+
Note [Aggregated demand for cardinality]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FIXME: This Note should be named [LetUp vs. LetDown] and probably predates
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-
ToDo [Oct 2013]
~~~~~~~~~~~~~~~
@@ -974,6 +975,14 @@ lookupHowBound env id = lookupVarEnv (sc_how_bound env) id
scSubstId :: ScEnv -> InId -> OutExpr
scSubstId env v = lookupIdSubst (sc_subst env) v
+
+-- Solo is only defined in base starting from ghc-9.2
+#if !(MIN_VERSION_base(4, 16, 0))
+
+data Solo a = Solo a
+
+#endif
+
-- The !subst ensures that we force the selection `(sc_subst env)`, which avoids
-- retaining all of `env` when we only need `subst`. The `Solo` means that the
-- substitution itself is lazy, because that type is often discarded.
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -94,6 +94,10 @@ This can be convenient when pasting large multi-line blocks of code into GHCi.
label (:base-ref:`GHC.Conc.threadLabel`) and status
(:base-ref:`GHC.Conc.threadStatus`).
+- Change default ``Ord`` implementation of ``(>=)``, ``(>)``, and ``(<)`` to use
+ ``(<=)`` instead of ``compare`` per CLC proposal:
+ https://github.com/haskell/core-libraries-committee/issues/24
+
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/base/changelog.md
=====================================
@@ -22,6 +22,9 @@
* `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label
of a given `ThreadId`.
* Add `inits1` and `tails1` to `Data.List.NonEmpty`.
+ * Change default `Ord` implementation of `(>=)`, `(>)`, and `(<)` to use
+ `(<=)` instead of `compare` per
+ [Core Libraries proposal](https://github.com/haskell/core-libraries-committee/issues/24).
## 4.17.0.0 *August 2022*
=====================================
libraries/ghc-prim/GHC/Classes.hs
=====================================
@@ -333,10 +333,11 @@ class (Eq a) => Ord a where
else if x <= y then LT
else GT
- x < y = case compare x y of { LT -> True; _ -> False }
x <= y = case compare x y of { GT -> False; _ -> True }
- x > y = case compare x y of { GT -> True; _ -> False }
- x >= y = case compare x y of { LT -> False; _ -> True }
+ x >= y = y <= x
+ x > y = not (x <= y)
+ x < y = not (y <= x)
+
-- These two default methods use '<=' rather than 'compare'
-- because the latter is often more expensive
=====================================
testsuite/tests/stranal/should_compile/T22039.hs
=====================================
@@ -0,0 +1,59 @@
+{-# LANGUAGE ExistentialQuantification #-}
+
+module Bug where
+
+import Control.Exception
+import Data.Typeable
+import Unsafe.Coerce
+
+data Error
+ = Error Int String
+ | forall e . Exception e => SomeError Int e
+ deriving (Typeable)
+
+fromError :: Exception e => Error -> Maybe e
+fromError e@(Error _ _) = cast e
+fromError (SomeError _ e) = cast e
+-- {-# NOINLINE fromError #-}
+
+instance Eq Error where
+ Error i s == Error i' s' = i == i' && s == s'
+ SomeError i e == SomeError i' e' = i == i' && show e == show e'
+ _ == _ = False
+
+instance Show Error where
+ show _ = ""
+
+instance Exception Error
+
+-- newtype
+data
+ UniquenessError = UniquenessError [((String, String), Int)]
+ deriving (Show, Eq)
+
+instance Exception UniquenessError
+
+test :: SomeException -> IO ()
+test e = case fromError =<< fromException e :: Maybe UniquenessError of
+ Just err -> print err
+ _ -> pure ()
+
+--
+-- Smaller reproducer by sgraf
+--
+
+blarg :: (Int,Int) -> Int
+blarg (x,y) = x+y
+{-# NOINLINE blarg #-}
+
+f :: Either Int Int -> Int
+f Left{} = 0
+f e = blarg (unsafeCoerce e)
+
+blurg :: (Int -> Int) -> Int
+blurg f = f 42
+{-# NOINLINE blurg #-}
+
+g :: Either Int Int -> Int
+g Left{} = 0
+g e = blurg (unsafeCoerce e)
=====================================
testsuite/tests/stranal/should_compile/all.T
=====================================
@@ -85,3 +85,4 @@ test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques
test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl'])
test('T21265', normal, compile, [''])
test('EtaExpansion', normal, compile, [''])
+test('T22039', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44a6a9caf7c3c6daa5cd61654046bdc868278953...7bd21f2e8d2424f02152c99f7ae3a381284d066e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44a6a9caf7c3c6daa5cd61654046bdc868278953...7bd21f2e8d2424f02152c99f7ae3a381284d066e
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220905/3ac69275/attachment-0001.html>
More information about the ghc-commits
mailing list