[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 2 commits: Use correct FunTyFlag in adjustJoinPointType

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Fri Sep 15 22:31:53 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
274798e5 by Simon Peyton Jones at 2023-09-15T18:31:38-04:00
Use correct FunTyFlag in adjustJoinPointType

As the Lint error in #23952 showed, the function adjustJoinPointType
was failing to adjust the FunTyFlag when adjusting the type.

I don't think this caused the seg-fault reported in the ticket,
but it is definitely.  This patch fixes it.

It is tricky to come up a small test case; Krzysztof came up with
this one, but it only triggers a failure in GHC 9.6.

- - - - -
95d3bb0b by Pierre Le Marre at 2023-09-15T18:31:41-04:00
Update to Unicode 15.1.0

See: https://www.unicode.org/versions/Unicode15.1.0/

- - - - -


17 changed files:

- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Types/Var.hs
- docs/users_guide/9.10.1-notes.rst
- libraries/base/GHC/Unicode/Internal/Char/DerivedCoreProperties.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
- libraries/base/GHC/Unicode/Internal/Version.hs
- libraries/base/changelog.md
- libraries/base/tests/unicode003.stdout
- libraries/base/tools/ucd2haskell/ucd.sh
- libraries/base/tools/ucd2haskell/unicode_version
- + testsuite/tests/simplCore/should_compile/T23952.hs
- + testsuite/tests/simplCore/should_compile/T23952a.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -58,29 +58,33 @@ import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Rules.Config ( RuleOpts(..) )
 import GHC.Core
 import GHC.Core.Utils
-import GHC.Core.Multiplicity     ( scaleScaled )
 import GHC.Core.Unfold
 import GHC.Core.TyCo.Subst (emptyIdSubstEnv)
+import GHC.Core.Multiplicity( Scaled(..), mkMultMul )
+import GHC.Core.Make            ( mkWildValBinder, mkCoreLet )
+import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, substCo
+                                , extendTvSubst, extendCvSubst )
+import qualified GHC.Core.Coercion as Coercion
+import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
+import qualified GHC.Core.Type as Type
+
 import GHC.Types.Var
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
+import GHC.Types.Id as Id
+import GHC.Types.Basic
+import GHC.Types.Unique.FM      ( pprUniqFM )
+
 import GHC.Data.OrdList
 import GHC.Data.Graph.UnVar
-import GHC.Types.Id as Id
-import GHC.Core.Make            ( mkWildValBinder, mkCoreLet )
+
 import GHC.Builtin.Types
-import qualified GHC.Core.Type as Type
-import GHC.Core.Type hiding     ( substTy, substTyVar, substTyVarBndr, substCo
-                                , extendTvSubst, extendCvSubst )
-import qualified GHC.Core.Coercion as Coercion
-import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr )
 import GHC.Platform ( Platform )
-import GHC.Types.Basic
+
 import GHC.Utils.Monad
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Utils.Misc
-import GHC.Types.Unique.FM      ( pprUniqFM )
 
 import Data.List ( intersperse, mapAccumL )
 
@@ -1170,21 +1174,34 @@ adjustJoinPointType mult new_res_ty join_id
   = assert (isJoinId join_id) $
     setIdType join_id new_join_ty
   where
-    orig_ar = idJoinArity join_id
-    orig_ty = idType join_id
-
-    new_join_ty = go orig_ar orig_ty :: Type
+    join_arity = idJoinArity join_id
+    orig_ty    = idType join_id
+    res_torc   = typeTypeOrConstraint new_res_ty :: TypeOrConstraint
+
+    new_join_ty = go join_arity orig_ty :: Type
+
+    go :: JoinArity -> Type -> Type
+    go n ty
+      | n == 0
+      = new_res_ty
+
+      | Just (arg_bndr, body_ty) <- splitPiTy_maybe ty
+      , let body_ty' = go (n-1) body_ty
+      = case arg_bndr of
+          Named b                          -> mkForAllTy b body_ty'
+          Anon (Scaled arg_mult arg_ty) af -> mkFunTy af' arg_mult' arg_ty body_ty'
+              where
+                -- Using "!": See Note [Bangs in the Simplifier]
+                -- mkMultMul: see Note [Scaling join point arguments]
+                !arg_mult' = arg_mult `mkMultMul` mult
+
+                -- the new_res_ty might be ConstraintLike while the original
+                -- one was TypeLike.  So we may need to adjust the FunTyFlag.
+                -- (see #23952)
+                !af' = mkFunTyFlag (funTyFlagArgTypeOrConstraint af) res_torc
 
-    go 0 _  = new_res_ty
-    go n ty | Just (arg_bndr, res_ty) <- splitPiTy_maybe ty
-            = mkPiTy (scale_bndr arg_bndr) $
-              go (n-1) res_ty
-            | otherwise
-            = pprPanic "adjustJoinPointType" (ppr orig_ar <+> ppr orig_ty)
-
-    -- See Note [Bangs in the Simplifier]
-    scale_bndr (Anon t af) = (Anon $! (scaleScaled mult t)) af
-    scale_bndr b@(Named _) = b
+      | otherwise
+      = pprPanic "adjustJoinPointType" (ppr join_arity <+> ppr orig_ty)
 
 {- Note [Scaling join point arguments]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -2567,12 +2567,12 @@ Here are the key kinding rules for types
           -- in GHC.Builtin.Types.Prim
 
           torc is TYPE or CONSTRAINT
-          ty : torc rep
+          ty : body_torc rep
           ki : Type
           `a` is a type variable
           `a` is not free in rep
 (FORALL1) -----------------------
-          forall (a::ki). ty : torc rep
+          forall (a::ki). ty : body_torc rep
 
           torc is TYPE or CONSTRAINT
           ty : body_torc rep


=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -76,7 +76,7 @@ module GHC.Types.Var (
         mkFunTyFlag, visArg, invisArg,
         visArgTypeLike, visArgConstraintLike,
         invisArgTypeLike, invisArgConstraintLike,
-        funTyFlagResultTypeOrConstraint,
+        funTyFlagArgTypeOrConstraint, funTyFlagResultTypeOrConstraint,
         TypeOrConstraint(..),  -- Re-export this: it's an argument of FunTyFlag
 
         -- * PiTyBinder
@@ -609,6 +609,12 @@ isFUNArg :: FunTyFlag -> Bool
 isFUNArg FTF_T_T = True
 isFUNArg _       = False
 
+funTyFlagArgTypeOrConstraint :: FunTyFlag -> TypeOrConstraint
+-- Whether it /takes/ a type or a constraint
+funTyFlagArgTypeOrConstraint FTF_T_T = TypeLike
+funTyFlagArgTypeOrConstraint FTF_T_C = TypeLike
+funTyFlagArgTypeOrConstraint _       = ConstraintLike
+
 funTyFlagResultTypeOrConstraint :: FunTyFlag -> TypeOrConstraint
 -- Whether it /returns/ a type or a constraint
 funTyFlagResultTypeOrConstraint FTF_T_T = TypeLike


=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -68,6 +68,8 @@ Runtime system
 ``base`` library
 ~~~~~~~~~~~~~~~~
 
+- Updated to `Unicode 15.1.0 <https://www.unicode.org/versions/Unicode15.1.0/>`_.
+
 ``ghc-prim`` library
 ~~~~~~~~~~~~~~~~~~~~
 


=====================================
libraries/base/GHC/Unicode/Internal/Char/DerivedCoreProperties.hs
=====================================
@@ -1,5 +1,5 @@
 -- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/DerivedCoreProperties.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/DerivedCoreProperties.txt.
 
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE MagicHash #-}


=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/GeneralCategory.hs
=====================================
The diff for this file was not included because it is too large.

=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleLowerCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
 -- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
 
 {-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
 {-# OPTIONS_HADDOCK hide #-}


=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleTitleCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
 -- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
 
 {-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
 {-# OPTIONS_HADDOCK hide #-}


=====================================
libraries/base/GHC/Unicode/Internal/Char/UnicodeData/SimpleUpperCaseMapping.hs
=====================================
@@ -1,5 +1,5 @@
 -- DO NOT EDIT: This file is automatically generated by the internal tool ucd2haskell,
--- with data from: https://www.unicode.org/Public/15.0.0/ucd/UnicodeData.txt.
+-- with data from: https://www.unicode.org/Public/15.1.0/ucd/UnicodeData.txt.
 
 {-# LANGUAGE NoImplicitPrelude, LambdaCase #-}
 {-# OPTIONS_HADDOCK hide #-}


=====================================
libraries/base/GHC/Unicode/Internal/Version.hs
=====================================
@@ -19,8 +19,8 @@ where
 import {-# SOURCE #-} Data.Version
 
 -- | Version of Unicode standard used by @base@:
--- [15.0.0](https://www.unicode.org/versions/Unicode15.0.0/).
+-- [15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
 --
 -- @since 4.15.0.0
 unicodeVersion :: Version
-unicodeVersion = makeVersion [15, 0, 0]
+unicodeVersion = makeVersion [15, 1, 0]


=====================================
libraries/base/changelog.md
=====================================
@@ -5,6 +5,7 @@
   * Add a `RULE` to `Prelude.lookup`, allowing it to participate in list fusion ([CLC proposal #174](https://github.com/haskell/core-libraries-committee/issues/175))
   * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
   * Add rewrite rules for conversion between Int64/Word64 and Float/Double on 64-bit architectures ([CLC proposal #203](https://github.com/haskell/core-libraries-committee/issues/203)).
+  * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
 
 ## 4.19.0.0 *TBA*
   * Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.


=====================================
libraries/base/tests/unicode003.stdout
=====================================
@@ -121,12 +121,12 @@ fa0,299354809,273668620
 2e7c,-303407671,86127504
 2ee0,962838393,-1874288820
 2f44,-1105473175,13438952
-2fa8,71804041,-1302289916
+2fa8,47615401,-1302289916
 300c,-617598666,1792393120
 3070,-284421394,-1091054596
 30d4,-1569867234,-249848968
 3138,-1522355883,1427914804
-319c,1411913369,-446832016
+319c,-1320418159,-446832016
 3200,-2097029110,-1317869076
 3264,7156258,-2084614840
 32c8,-1105473175,1921081060
@@ -1913,13 +1913,13 @@ ffdc,-2015459986,1906523440
 2ea7c,657752308,1252972432
 2eae0,657752308,-1692480692
 2eb44,657752308,1525062632
-2eba8,-13042365,-1770478076
-2ec0c,-847508383,1811413920
-2ec70,-847508383,-251803652
-2ecd4,-847508383,1750663032
-2ed38,-847508383,874626100
-2ed9c,-847508383,-1363708304
-2ee00,-847508383,835415532
+2eba8,-2011303353,-1770478076
+2ec0c,657752308,1811413920
+2ec70,657752308,-251803652
+2ecd4,657752308,1750663032
+2ed38,657752308,874626100
+2ed9c,657752308,-1363708304
+2ee00,-1295156710,835415532
 2ee64,-847508383,-755707576
 2eec8,-847508383,440599268
 2ef2c,-847508383,-663642880


=====================================
libraries/base/tools/ucd2haskell/ucd.sh
=====================================
@@ -12,8 +12,8 @@ VERIFY_CHECKSUM=y
 
 # Filename:checksum
 FILES="\
-  ucd/DerivedCoreProperties.txt:d367290bc0867e6b484c68370530bdd1a08b6b32404601b8c7accaf83e05628d \
-  ucd/UnicodeData.txt:806e9aed65037197f1ec85e12be6e8cd870fc5608b4de0fffd990f689f376a73"
+  ucd/DerivedCoreProperties.txt:f55d0db69123431a7317868725b1fcbf1eab6b265d756d1bd7f0f6d9f9ee108b \
+  ucd/UnicodeData.txt:2fc713e6a31a87c4850a37fe2caffa4218180fadb5de86b43a143ddb4581fb86"
 
 # Download the files
 


=====================================
libraries/base/tools/ucd2haskell/unicode_version
=====================================
@@ -1 +1 @@
-VERSION="15.0.0"
+VERSION="15.1.0"


=====================================
testsuite/tests/simplCore/should_compile/T23952.hs
=====================================
@@ -0,0 +1,31 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- The Lint failure in in #23952 is very hard to trigger.
+-- The test case fails with GHC 9.6, but not 9.4, 9.8, or HEAD.
+-- But still, better something than nothing.
+
+module T23952 where
+
+import T23952a
+import Data.Proxy
+import Data.Kind
+
+type Filter :: Type -> Type
+data Filter ty = FilterWithMain Int Bool
+
+new :: forall n . Eq n => () -> Filter n
+{-# INLINABLE new #-}
+new _ = toFilter
+
+class FilterDSL x where
+  toFilter :: Filter x
+
+instance Eq c => FilterDSL c where
+  toFilter = case (case fromRep cid == cid of
+                     True -> FilterWithMain cid False
+                     False -> FilterWithMain cid True
+                  ) of FilterWithMain c x -> FilterWithMain (c+1) (not x)
+            where cid :: Int
+                  cid = 3
+  {-# INLINE toFilter #-}


=====================================
testsuite/tests/simplCore/should_compile/T23952a.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE DerivingVia #-}
+module T23952a where
+
+class AsRep rep a where
+  fromRep :: rep -> a
+
+newtype ViaIntegral a = ViaIntegral a
+  deriving newtype (Eq, Ord, Real, Enum, Num, Integral)
+
+instance forall a n . (Integral a, Integral n, Eq a) => AsRep a (ViaIntegral n) where
+  fromRep r = fromIntegral $ r + 2
+  {-# INLINE fromRep #-}
+
+deriving via (ViaIntegral Int) instance (Integral r) => AsRep r Int


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -500,3 +500,4 @@ test('T22404', [only_ways(['optasm']), check_errmsg(r'let') ], compile, ['-ddump
 test('T23864', normal, compile, ['-O -dcore-lint -package ghc -Wno-gadt-mono-local-binds'])
 test('T23938', [extra_files(['T23938A.hs'])], multimod_compile, ['T23938', '-O -v0'])
 test('T23922a', normal, compile, ['-O'])
+test('T23952', [extra_files(['T23952a.hs'])], multimod_compile, ['T23952', '-v0 -O'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/117e33845b9b5f5782475e8c76c631984611f6f5...95d3bb0b79ac04b6116d5aa6a7ff4d616ee90bab

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/117e33845b9b5f5782475e8c76c631984611f6f5...95d3bb0b79ac04b6116d5aa6a7ff4d616ee90bab
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/20230915/4948901a/attachment-0001.html>


More information about the ghc-commits mailing list