[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Fix eventlog all option

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Nov 23 10:04:35 UTC 2022



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


Commits:
9479594d by Teo Camarasu at 2022-11-23T05:04:10-05:00
Fix eventlog all option

Previously it didn't enable/disable nonmoving_gc and ticky event types

Fixes #21813

- - - - -
cef3abfa by Arnaud Spiwack at 2022-11-23T05:04:12-05:00
Expand Note [Linear types] with the stance on linting linearity

Per the discussion on #22123

- - - - -
309b3f4e by Lawton Nichols at 2022-11-23T05:04:15-05:00
Add documentation on custom Prelude modules (#22228)

Specifically, custom Prelude modules that are named `Prelude`.

- - - - -
8e6d19c7 by Sylvain Henry at 2022-11-23T05:04:19-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.

- - - - -
66dc3992 by nineonine at 2022-11-23T05:04:20-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

- - - - -


23 changed files:

- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Multiplicity.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- configure.ac
- docs/users_guide/9.6.1-notes.rst
- docs/users_guide/exts/ffi.rst
- docs/users_guide/exts/rebindable_syntax.rst
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/Foreign/C/Types.hs
- m4/fp_bfd_support.m4
- m4/fp_cc_supports__atomics.m4
- m4/fp_check_pthreads.m4
- rts/RtsFlags.c
- + testsuite/tests/ffi/should_compile/T22034.h
- + testsuite/tests/ffi/should_compile/T22034.hs
- + testsuite/tests/ffi/should_compile/T22034_c.c
- testsuite/tests/ffi/should_compile/all.T


Changes:

=====================================
compiler/GHC/Builtin/Names.hs
=====================================
@@ -350,7 +350,7 @@ basicKnownKeyNames
         zipName, foldrName, buildName, augmentName, appendName,
 
         -- FFI primitive types that are not wired-in.
-        stablePtrTyConName, ptrTyConName, funPtrTyConName,
+        stablePtrTyConName, ptrTyConName, funPtrTyConName, constPtrConName,
         int8TyConName, int16TyConName, int32TyConName, int64TyConName,
         word8TyConName, word16TyConName, word32TyConName, word64TyConName,
 
@@ -557,7 +557,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 :: Module
+    dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE, fOREIGN_C_TYPES :: Module
 
 gHC_PRIM        = mkPrimModule (fsLit "GHC.Prim")   -- Primitive types and values
 gHC_PRIM_PANIC  = mkPrimModule (fsLit "GHC.Prim.Panic")
@@ -627,6 +627,7 @@ gHC_TYPENATS_INTERNAL = mkBaseModule (fsLit "GHC.TypeNats.Internal")
 dATA_COERCE     = mkBaseModule (fsLit "Data.Coerce")
 dEBUG_TRACE     = mkBaseModule (fsLit "Debug.Trace")
 uNSAFE_COERCE   = mkBaseModule (fsLit "Unsafe.Coerce")
+fOREIGN_C_TYPES = mkBaseModule (fsLit "Foreign.C.Types")
 
 gHC_SRCLOC :: Module
 gHC_SRCLOC = mkBaseModule (fsLit "GHC.SrcLoc")
@@ -1665,6 +1666,10 @@ fingerprintDataConName :: Name
 fingerprintDataConName =
     dcQual gHC_FINGERPRINT_TYPE (fsLit "Fingerprint") fingerprintDataConKey
 
+constPtrConName :: Name
+constPtrConName =
+    tcQual fOREIGN_C_TYPES (fsLit "ConstPtr") constPtrTyConKey
+
 {-
 ************************************************************************
 *                                                                      *
@@ -1866,7 +1871,7 @@ statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey,
     eqReprPrimTyConKey, eqPhantPrimTyConKey,
     compactPrimTyConKey, stackSnapshotPrimTyConKey,
-    promptTagPrimTyConKey :: Unique
+    promptTagPrimTyConKey, constPtrTyConKey :: Unique
 statePrimTyConKey                       = mkPreludeTyConUnique 50
 stableNamePrimTyConKey                  = mkPreludeTyConUnique 51
 stableNameTyConKey                      = mkPreludeTyConUnique 52
@@ -2077,6 +2082,7 @@ typeConsSymbolTyFamNameKey = mkPreludeTyConUnique 413
 typeUnconsSymbolTyFamNameKey = mkPreludeTyConUnique 414
 typeCharToNatTyFamNameKey = mkPreludeTyConUnique 415
 typeNatToCharTyFamNameKey = mkPreludeTyConUnique 416
+constPtrTyConKey = mkPreludeTyConUnique 417
 
 {-
 ************************************************************************


=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -2863,21 +2863,86 @@ we behave as follows (#15057, #T15664):
 
 Note [Linting linearity]
 ~~~~~~~~~~~~~~~~~~~~~~~~
-There is one known optimisations that have not yet been updated
-to work with Linear Lint:
-
-* Optimisations can create a letrec which uses a variable linearly, e.g.
-    letrec f True = f False
-           f False = x
-    in f True
-  uses 'x' linearly, but this is not seen by the linter.
-  Plan: make let-bound variables remember the usage environment.
-  See ticket #18694.
-
-We plan to fix this issue in the very near future.
-For now, -dcore-lint enables only linting output of the desugarer,
-and full Linear Lint has to be enabled separately with -dlinear-core-lint.
-Ticket #19165 concerns enabling Linear Lint with -dcore-lint.
+Core understands linear types: linearity is checked with the flag
+`-dlinear-core-lint`. Why not make `-dcore-lint` check linearity?  Because
+optimisation passes are not (yet) guaranteed to maintain linearity.  They should
+do so semantically (GHC is careful not to duplicate computation) but it is much
+harder to ensure that the statically-checkable constraints of Linear Core are
+maintained. The current Linear Core is described in the wiki at:
+https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation.
+
+Why don't the optimisation passes maintain the static types of Linear Core?
+Because doing so would cripple some important optimisations.  Here is an
+example:
+
+  data T = MkT {-# UNPACK #-} !Int
+
+The wrapper for MkT is
+
+  $wMkT :: Int %1 -> T
+  $wMkT n = case %1 n of
+    I# n' -> MkT n'
+
+This introduces, in particular, a `case %1` (this is not actual Haskell or Core
+syntax), where the `%1` means that the `case` expression consumes its scrutinee
+linearly.
+
+Now, `case %1` interacts with the binder swap optimisation in a non-trivial
+way. Take a slightly modified version of the code for $wMkT:
+
+  case %1 x of z {
+    I# n' -> (x, n')
+  }
+
+Binder-swap wants to change this to
+
+  case %1 x of z {
+    I# n' -> let x = z in (x, n')
+  }
+
+Now, this is not something that a linear type checker usually considers
+well-typed. It is not something that `-dlinear-core-lint` considers to be
+well-typed either. But it's only because `-dlinear-core-lint` is not good
+enough. However, making `-dlinear-core-lint` recognise this expression as valid
+is not obvious. There are many such interactions between a linear type system
+and GHC optimisations documented in the linear-type implementation wiki page
+[https://gitlab.haskell.org/ghc/ghc/-/wikis/linear-types/implementation#core-to-core-passes].
+
+PRINCIPLE: The type system bends to the optimisation, not the other way around.
+
+In the original linear-types implementation, we had tried to make every
+optimisation pass produce code that passes `-dlinear-core-lint`. It had proved
+very difficult. And we kept finding corner case after corner case.  Plus, we
+used to restrict transformations when `-dlinear-core-lint` couldn't typecheck
+the result. There are still occurrences of such restrictions in the code. But
+our current stance is that such restrictions can be removed.
+
+For instance, some optimisations can create a letrec which uses a variable
+linearly, e.g.
+
+  letrec f True = f False
+         f False = x
+  in f True
+
+uses 'x' linearly, but this is not seen by the linter. This issue is discussed
+in  ticket #18694.
+
+Plus in many cases, in order to make a transformation compatible with linear
+linting, we ended up restricting to avoid producing patterns that were not
+recognised as linear by the linter. This violates the above principle.
+
+In the future, we may be able to lint the linearity of the output of
+Core-to-Core passes (#19165). But right now, we can't. Therefore, in virtue of
+the principle above, after the desguarer, the optimiser should take no special
+pains to preserve linearity (in the type system sense).
+
+In general the optimiser tries hard not to lose sharing, so it probably doesn't
+actually make linear things non-linear. We postulate that any program
+transformation which breaks linearity would negatively impact performance, and
+therefore wouldn't be suitable for an optimiser. An alternative to linting
+linearity after each pass is to prove this statement.
+
+There is a useful discussion at https://gitlab.haskell.org/ghc/ghc/-/issues/22123
 
 Note [checkCanEtaExpand]
 ~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/GHC/Core/Multiplicity.hs
=====================================
@@ -51,22 +51,30 @@ The detailed design is in the _Linear Haskell_ article
 [https://arxiv.org/abs/1710.09756]. Other important resources in the linear
 types implementation wiki page
 [https://gitlab.haskell.org/ghc/ghc/wikis/linear-types/implementation], and the
-proposal [https://github.com/ghc-proposals/ghc-proposals/pull/111] which
+proposal [https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0111-linear-types.rst] which
 describes the concrete design at length.
 
 For the busy developer, though, here is a high-level view of linear types is the following:
 
 - Function arrows are annotated with a multiplicity (as defined by type `Mult`
   and its smart constructors in this module)
-    - Because, as a type constructor, the type of function now has an extra
-      argument, the notation (->) is no longer suitable. We named the function
-      type constructor `FUN`.
-    - (->) retains its backward compatible meaning: `(->) a b = a -> b`. To
-      achieve this, `(->)` is defined as a type synonym to `FUN Many` (see
+    - Multiplicities, in Haskell, are types of kind `GHC.Types.Multiplicity`.
+      as in
+
+        map :: forall (p :: Multiplicity). (a %p -> b) -> [a] %p -> [b]
+
+    - The type constructor for function types (FUN) has type
+
+        FUN :: forall (m :: Multiplicity) -> forall {r1) {r2}. TYPE r1 -> TYPE r2 -> Type
+
+      The argument order is explained in https://gitlab.haskell.org/ghc/ghc/-/issues/20164
+    - (->) retains its backward compatible meaning:
+
+        (->) a b = a -> b = a %'Many -> b
+
+      To achieve this, `(->)` is defined as a type synonym to `FUN Many` (see
       below).
-- Multiplicities can be reified in Haskell as types of kind
-  `GHC.Types.Multiplicity`
-- Ground multiplicity (that is, without a variable) can be `One` or `Many`
+- A ground multiplicity (that is, without a variable) can be `One` or `Many`
   (`Many` is generally rendered as ω in the scientific literature).
   Functions whose type is annotated with `One` are linear functions, functions whose
   type is annotated with `Many` are regular functions, often called “unrestricted”
@@ -75,19 +83,9 @@ For the busy developer, though, here is a high-level view of linear types is the
   consumed exactly once, *then* its argument is consumed exactly once. You can
   think of “consuming exactly once” as evaluating a value in normal form exactly
   once (though not necessarily in one go). The _Linear Haskell_ article (see
-  infra) has a more precise definition of “consuming exactly once”.
-- Data types can have unrestricted fields (the canonical example being the
-  `Unrestricted` data type), then these don't need to be consumed for a value to
-  be consumed exactly once. So consuming a value of type `Unrestricted` exactly
-  once means forcing it at least once.
-- Why “at least once”? Because if `case u of { C x y -> f (C x y) }` is linear
-  (provided `f` is a linear function). So we might as well have done `case u of
-  { !z -> f z }`. So, we can observe constructors as many times as we want, and
-  we are actually allowed to force the same thing several times because laziness
-  means that we are really forcing a the value once, and observing its
-  constructor several times. The type checker and the linter recognise some (but
-  not all) of these multiple forces as indeed linear. Mostly just enough to
-  support variable patterns.
+  supra) has a more precise definition of “consuming exactly once”.
+- Data constructors are linear by default.
+  See Note [Data constructors are linear by default].
 - Multiplicities form a semiring.
 - Multiplicities can also be variables and we can universally quantify over
   these variables. This is referred to as “multiplicity
@@ -102,6 +100,8 @@ For the busy developer, though, here is a high-level view of linear types is the
   multiplicity `Many` can consume its scrutinee as many time as it wishes (no
   matter how much the case expression is consumed).
 
+For linear types in the linter see Note [Linting linearity] in GHC.Core.Lint.
+
 Note [Usages]
 ~~~~~~~~~~~~~
 In the _Linear Haskell_ paper, you'll find typing rules such as these:
@@ -208,8 +208,8 @@ branch.
 
 Note [Data constructors are linear by default]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Data constructors defined without -XLinearTypes (as well as data constructors
-defined with the Haskell 98 in all circumstances) have all their fields linear.
+All data constructors defined without -XLinearTypes, as well as data constructors
+defined with the Haskell 98 in all circumstances, have all their fields linear.
 
 That is, in
 
@@ -219,10 +219,52 @@ We have
 
     Just :: a %1 -> Just a
 
+Irrespective of whether -XLinearTypes is turned on or not. Furthermore, when
+-XLinearTypes is turned off, the declaration
+
+    data Endo a where { MkIntEndo :: (Int -> Int) -> T Int }
+
+gives
+
+    MkIntEndo :: (Int -> Int) %1 -> T Int
+
+With -XLinearTypes turned on, instead, this would give
+
+    data EndoU a where { MkIntEndoU :: (Int -> Int) -> T Int }
+    MkIntEndoU :: (Int -> Int) -> T Int
+
+With -XLinearTypes turned on, to get a linear field with GADT syntax we
+would need to write
+
+    data EndoL a where { MkIntEndoL :: (Int -> Int) %1 -> T Int }
+
 The goal is to maximise reuse of types between linear code and traditional
 code. This is argued at length in the proposal and the article (links in Note
 [Linear types]).
 
+Unrestricted field don't need to be consumed for a value to be consumed exactly
+once. So consuming a value of type `IntEndoU a` exactly once means forcing it at
+least once.
+
+Why “at least once”? Because if `case u of { MkIntEndoL x -> f (MkIntEndoL x) }`
+is linear (provided `f` is a linear function). But we might as well have done
+`case u of { !z -> f z }`. So, we can observe constructors as many times as we
+want, and we are actually allowed to force the same thing several times because
+laziness means that we are really forcing the value once, and observing its
+constructor several times. The type checker and the linter recognise some (but
+not all) of these multiple forces as indeed linear. Mostly just enough to
+support variable patterns.
+
+In summary:
+
+- Fields of data constructors defined with Haskell 98 syntax are always linear
+  (even if `-XLinearTypes` is off). This choice has been made to favour sharing
+  types between linearly typed Haskell and traditional Haskell. To avoid an
+  ecosystem split.
+- When `-XLinearTypes` is off, GADT-syntax declaration can only use the regular
+  arrow `(->)`. However all the fields are linear.
+
+
 Note [Polymorphisation of linear fields]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The choice in Note [Data constructors are linear by default] has an impact on


=====================================
compiler/GHC/HsToCore/Foreign/C.hs
=====================================
@@ -246,10 +246,18 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
         -> DsM ([(Id, Expr TyVar)], CHeader, CStub)
 dsFCall fn_id co fcall mDeclHeader = do
     let
-        ty                   = coercionLKind co
+        (ty,ty1)             = (coercionLKind co, coercionRKind co)
         (tv_bndrs, rho)      = tcSplitForAllTyVarBinders ty
         (arg_tys, io_res_ty) = tcSplitFunTys rho
 
+    let constQual -- provide 'const' qualifier (#22034)
+          | (_, res_ty1) <- tcSplitFunTys ty1
+          , newty <- maybe res_ty1 snd (tcSplitIOType_maybe res_ty1)
+          , Just (ptr, _) <- splitTyConApp_maybe newty
+          , tyConName ptr `elem` [constPtrConName]
+          = text "const"
+          | otherwise = empty
+
     args <- newSysLocalsDs arg_tys  -- no FFI representation polymorphism
     (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args)
 
@@ -277,7 +285,7 @@ dsFCall fn_id co fcall mDeclHeader = do
                       includes = vcat [ text "#include \"" <> ftext h
                                         <> text "\""
                                       | Header _ h <- nub headers ]
-                      fun_proto = cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes
+                      fun_proto = constQual <+> cResType <+> pprCconv <+> ppr wrapperName <> parens argTypes
                       cRet
                        | isVoidRes =                   cCall
                        | otherwise = text "return" <+> cCall


=====================================
configure.ac
=====================================
@@ -943,9 +943,9 @@ AC_CHECK_LIB(m, atan, HaveLibM=YES, HaveLibM=NO)
 if test $HaveLibM = YES
 then
   AC_DEFINE([HAVE_LIBM], [1], [Define to 1 if you need to link with libm])
-  AC_SUBST([CabalHaveLibm],[True])
+  AC_SUBST([UseLibm],[YES])
 else
-  AC_SUBST([CabalHaveLibm],[False])
+  AC_SUBST([UseLibm],[NO])
 fi
 TargetHasLibm=$HaveLibM
 AC_SUBST(TargetHasLibm)
@@ -958,15 +958,11 @@ dnl ################################################################
 
 FP_FIND_LIBFFI
 AC_SUBST(UseSystemLibFFI)
-AS_IF([test "x$with_system_libffi" = "xyes"],
-  [CabalUseSystemLibFFI="True"],
-  [CabalUseSystemLibFFI="False"]
-)
-AC_SUBST(CabalUseSystemLibFFI)
 
 dnl ** check whether we need -ldl to get dlopen()
 AC_CHECK_LIB([dl], [dlopen])
-AC_CHECK_LIB([dl], [dlopen], [AC_SUBST([CabalHaveLibdl], [True])], [AC_SUBST([CabalHaveLibdl], [False])])
+AC_CHECK_LIB([dl], [dlopen], HaveLibdl=YES, HaveLibdl=NO)
+AC_SUBST([UseLibdl],[$HaveLibdl])
 dnl ** check whether we have dlinfo
 AC_CHECK_FUNCS([dlinfo])
 
@@ -1003,7 +999,13 @@ FP_MUSTTAIL
 
 dnl ** check for librt
 AC_CHECK_LIB([rt], [clock_gettime])
-AC_CHECK_LIB([rt], [clock_gettime], [AC_SUBST([CabalHaveLibrt], [True])], [AC_SUBST([CabalHaveLibrt], [False])])
+AC_CHECK_LIB([rt], [clock_gettime], HaveLibrt=YES, HaveLibrt=NO)
+if test $HaveLibrt = YES
+then
+  AC_SUBST([UseLibrt],[YES])
+else
+  AC_SUBST([UseLibrt],[NO])
+fi
 AC_CHECK_FUNCS(clock_gettime timer_settime)
 FP_CHECK_TIMER_CREATE
 
@@ -1119,11 +1121,6 @@ AC_DEFINE_UNQUOTED([RTS_LINKER_USE_MMAP], [$RtsLinkerUseMmap],
 
 GHC_ADJUSTORS_METHOD([Target])
 AC_SUBST([UseLibffiForAdjustors])
-AS_IF([test x"${UseLibffiForAdjustors}" = x"YES"],
-  [CabalLibffiAdjustors=True],
-  [CabalLibffiAdjustors=False]
-)
-AC_SUBST([CabalLibffiAdjustors])
 
 dnl ** Other RTS features
 dnl --------------------------------------------------------------
@@ -1173,12 +1170,6 @@ if grep '	' compiler/ghc.cabal.in 2>&1 >/dev/null; then
    AC_MSG_ERROR([compiler/ghc.cabal.in contains tab characters; please remove them])
 fi
 
-# Create the configuration for the Hadrian build system if it is present
-if test -e hadrian/cfg/system.config.in; then
-    AC_CONFIG_FILES([hadrian/cfg/system.config])
-    AC_CONFIG_FILES([hadrian/ghci-cabal hadrian/ghci-stack hadrian/ghci-multi-cabal])
-fi
-
 # We got caught by
 #     http://savannah.gnu.org/bugs/index.php?1516
 #     $(eval ...) inside conditionals causes errors
@@ -1202,27 +1193,12 @@ checkMake380() {
 checkMake380 make
 checkMake380 gmake
 
-AC_CONFIG_FILES([ mk/project.mk ])
-
-dnl When adding things to this list be sure to update hadrian's
-dnl Rules.Configure.configureResults list.
 AC_CONFIG_FILES(
-[ rts/rts.cabal
-  compiler/ghc.cabal
-  ghc/ghc-bin.cabal
-  utils/runghc/runghc.cabal
-  driver/ghci/ghci-wrapper.cabal
-  utils/iserv/iserv.cabal
-  utils/ghc-pkg/ghc-pkg.cabal
-  utils/remote-iserv/remote-iserv.cabal
-  libraries/ghc-boot/ghc-boot.cabal
-  libraries/ghc-boot-th/ghc-boot-th.cabal
-  libraries/ghci/ghci.cabal
-  libraries/ghc-heap/ghc-heap.cabal
-  libraries/libiserv/libiserv.cabal
-  libraries/template-haskell/template-haskell.cabal
+[ mk/project.mk
+  hadrian/cfg/system.config
+  hadrian/ghci-cabal
+  hadrian/ghci-stack
   docs/users_guide/ghc_config.py
-  libraries/prologue.txt
   distrib/configure.ac
 ])
 


=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -157,6 +157,9 @@ Runtime system
 ``ghc`` library
 ~~~~~~~~~~~~~~~
 
+- Add `Foreign.C.Types.ConstPtr` was added to encode ``const``-qualified pointer return
+  types in foreign declarations when using ``CApiFFI`` extension.
+
 ``ghc-heap`` library
 ~~~~~~~~~~~~~~~~~~~~
 


=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -437,6 +437,18 @@ specified. The syntax looks like: ::
     data    {-# CTYPE "unistd.h" "useconds_t" #-} T = ...
     newtype {-# CTYPE            "useconds_t" #-} T = ...
 
+In case foreign declarations contain ``const``-qualified pointer return
+type, `ConstPtr` from :base-ref:`Foreign.C.Types` may be used to
+encode this, e.g. ::
+
+    foreign import capi "header.h f" f :: CInt -> ConstPtr CInt
+
+which corresponds to
+
+.. code-block:: c
+
+    const *int f(int);
+
 ``hs_thread_done()``
 ~~~~~~~~~~~~~~~~~~~~
 


=====================================
docs/users_guide/exts/rebindable_syntax.rst
=====================================
@@ -14,9 +14,7 @@ Rebindable syntax and the implicit Prelude import
 
 GHC normally imports ``Prelude.hi`` files for
 you. If you'd rather it didn't, then give it a ``-XNoImplicitPrelude``
-option. The idea is that you can then import a Prelude of your own. (But
-don't call it ``Prelude``; the Haskell module namespace is flat, and you
-must not conflict with any Prelude module.)
+option. The idea is that you can then import a Prelude of your own.
 
 .. extension:: RebindableSyntax
     :shortdesc: Employ rebindable syntax.
@@ -91,6 +89,47 @@ Be warned: this is an experimental facility, with fewer checks than
 usual. Use ``-dcore-lint`` to typecheck the desugared program. If Core
 Lint is happy you should be all right.
 
+Custom Prelude modules named ``Prelude``
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+If you call your custom Prelude module ``Prelude`` and place it in a file called
+``Prelude.hs``, then your custom Prelude will be implicitly imported instead of
+the default Prelude.
+
+Here is an example that compiles: ::
+
+    $ cat Prelude.hs
+    module Prelude where
+
+    a = ()
+
+    $ cat B.hs
+    module B where
+
+    foo = a
+
+    $ ghc Prelude.hs B.hs
+    [1 of 2] Compiling Prelude          ( Prelude.hs, Prelude.o )
+    [2 of 2] Compiling B                ( B.hs, B.o )
+
+The new ``Prelude`` is implicitly imported in ``B.hs``.
+
+Here is an example that does not compile: ::
+
+    $ cat Prelude.hs
+    module Prelude where
+
+    foo = True
+
+    $ ghc Prelude.hs
+    [1 of 1] Compiling Prelude          ( Prelude.hs, Prelude.o )
+
+    Prelude.hs:3:7: error: Data constructor not in scope: True
+
+The original ``Prelude`` module is shadowed by the custom Prelude in this case.
+To include the original Prelude in your custom Prelude, you can explicitly
+import it with the ``-XPackageImports`` option and ``import "base" Prelude``.
+
 Things unaffected by :extension:`RebindableSyntax`
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 


=====================================
hadrian/cfg/system.config.in
=====================================
@@ -90,13 +90,14 @@ ghc-patch-level       = @GhcPatchLevel@
 
 bootstrap-threaded-rts      = @GhcThreadedRts@
 
-project-name          = @ProjectName@
-project-version       = @ProjectVersion@
-project-version-int   = @ProjectVersionInt@
-project-patch-level   = @ProjectPatchLevel@
-project-patch-level1  = @ProjectPatchLevel1@
-project-patch-level2  = @ProjectPatchLevel2@
-project-git-commit-id = @ProjectGitCommitId@
+project-name           = @ProjectName@
+project-version        = @ProjectVersion@
+project-version-munged = @ProjectVersionMunged@
+project-version-int    = @ProjectVersionInt@
+project-patch-level    = @ProjectPatchLevel@
+project-patch-level1   = @ProjectPatchLevel1@
+project-patch-level2   = @ProjectPatchLevel2@
+project-git-commit-id  = @ProjectGitCommitId@
 
 # Compilation and linking flags:
 #===============================
@@ -201,6 +202,12 @@ libnuma-lib-dir       = @LibNumaLibDir@
 # Optional Dependencies:
 #=======================
 
-with-libdw = @UseLibdw@
-with-libnuma = @UseLibNuma@
-have-lib-mingw-ex = @HaveLibMingwEx@
+use-lib-dw        = @UseLibdw@
+use-lib-numa      = @UseLibNuma@
+use-lib-mingw-ex  = @HaveLibMingwEx@
+use-lib-m         = @UseLibm@
+use-lib-rt        = @UseLibrt@
+use-lib-dl        = @UseLibdl@
+use-lib-bfd       = @UseLibbfd@
+use-lib-pthread   = @UseLibpthread@
+need-libatomic    = @NeedLibatomic@


=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -27,13 +27,19 @@ data Flag = ArSupportsAtFile
           | GmpFrameworkPref
           | LeadingUnderscore
           | SolarisBrokenShld
-          | WithLibdw
-          | WithLibnuma
-          | HaveLibMingwEx
           | UseSystemFfi
           | BootstrapThreadedRts
           | BootstrapEventLoggingRts
           | UseLibffiForAdjustors
+          | UseLibdw
+          | UseLibnuma
+          | UseLibmingwex
+          | UseLibm
+          | UseLibrt
+          | UseLibdl
+          | UseLibbfd
+          | UseLibpthread
+          | NeedLibatomic
 
 -- Note, if a flag is set to empty string we treat it as set to NO. This seems
 -- fragile, but some flags do behave like this.
@@ -51,13 +57,19 @@ flag f = do
             GmpFrameworkPref     -> "gmp-framework-preferred"
             LeadingUnderscore    -> "leading-underscore"
             SolarisBrokenShld    -> "solaris-broken-shld"
-            WithLibdw            -> "with-libdw"
-            WithLibnuma          -> "with-libnuma"
-            HaveLibMingwEx       -> "have-lib-mingw-ex"
             UseSystemFfi         -> "use-system-ffi"
             BootstrapThreadedRts -> "bootstrap-threaded-rts"
             BootstrapEventLoggingRts -> "bootstrap-event-logging-rts"
             UseLibffiForAdjustors -> "use-libffi-for-adjustors"
+            UseLibdw             -> "use-lib-dw"
+            UseLibnuma           -> "use-lib-numa"
+            UseLibmingwex        -> "use-lib-mingw-ex"
+            UseLibm              -> "use-lib-m"
+            UseLibrt             -> "use-lib-rt"
+            UseLibdl             -> "use-lib-dl"
+            UseLibbfd            -> "use-lib-bfd"
+            UseLibpthread        -> "use-lib-pthread"
+            NeedLibatomic        -> "need-libatomic"
     value <- lookupSystemConfig key
     when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
         ++ quote (key ++ " = " ++ value) ++ " cannot be parsed."


=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -65,6 +65,7 @@ data Setting = BuildArch
              | ProjectName
              | ProjectVersion
              | ProjectVersionInt
+             | ProjectVersionMunged
              | ProjectPatchLevel
              | ProjectPatchLevel1
              | ProjectPatchLevel2
@@ -165,6 +166,7 @@ setting key = lookupSystemConfig $ case key of
     ProjectGitCommitId -> "project-git-commit-id"
     ProjectName        -> "project-name"
     ProjectVersion     -> "project-version"
+    ProjectVersionMunged -> "project-version-munged"
     ProjectVersionInt  -> "project-version-int"
     ProjectPatchLevel  -> "project-patch-level"
     ProjectPatchLevel1 -> "project-patch-level1"


=====================================
hadrian/src/Rules.hs
=====================================
@@ -130,6 +130,7 @@ buildRules = do
     Rules.BinaryDist.bindistRules
     Rules.Generate.copyRules
     Rules.Generate.generateRules
+    Rules.Generate.templateRules
     Rules.Gmp.gmpRules
     Rules.Libffi.libffiRules
     Rules.Library.libraryRules


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -1,7 +1,8 @@
 module Rules.Generate (
     isGeneratedCmmFile, compilerDependencies, generatePackageCode,
     generateRules, copyRules, generatedDependencies,
-    ghcPrimDependencies
+    ghcPrimDependencies,
+    templateRules
     ) where
 
 import qualified Data.Set as Set
@@ -225,6 +226,72 @@ emptyTarget :: Context
 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
                              (error "Rules.Generate.emptyTarget: unknown package")
 
+-- | Files generated by query-replace from a template
+templateResults :: [FilePath]
+templateResults =
+    [ "compiler/ghc.cabal"
+    , "rts/rts.cabal"
+    , "driver/ghci/ghci-wrapper.cabal"
+    , "ghc/ghc-bin.cabal"
+    , "utils/iserv/iserv.cabal"
+    , "utils/iserv-proxy/iserv-proxy.cabal"
+    , "utils/remote-iserv/remote-iserv.cabal"
+    , "utils/runghc/runghc.cabal"
+    , "libraries/ghc-boot/ghc-boot.cabal"
+    , "libraries/ghc-boot-th/ghc-boot-th.cabal"
+    , "libraries/ghci/ghci.cabal"
+    , "libraries/ghc-heap/ghc-heap.cabal"
+    , "utils/ghc-pkg/ghc-pkg.cabal"
+    , "libraries/libiserv/libiserv.cabal"
+    , "libraries/template-haskell/template-haskell.cabal"
+    , "libraries/prologue.txt"
+    ]
+
+templateRules :: Rules ()
+templateRules = do
+  templateResults |%> \out -> do
+    let settingWord :: Setting -> Action Word
+        settingWord s = read <$> setting s
+
+    project_version        <- setting ProjectVersion
+    project_version_munged <- setting ProjectVersionMunged
+    target_word_size       <- settingWord TargetWordSize
+    lib_dw                 <- flag UseLibdw
+    lib_numa               <- flag UseLibnuma
+    lib_mingwex            <- flag UseLibmingwex
+    lib_m                  <- flag UseLibm
+    lib_rt                 <- flag UseLibrt
+    lib_dl                 <- flag UseLibdl
+    lib_ffi                <- flag UseSystemFfi
+    lib_ffi_adjustors      <- flag UseLibffiForAdjustors
+    lib_bfd                <- flag UseLibbfd
+    lib_pthread            <- flag UseLibpthread
+    leading_underscore     <- flag LeadingUnderscore
+    need_libatomic         <- flag NeedLibatomic
+
+    let cabal_bool True  = "True"
+        cabal_bool False = "False"
+
+        subst = replace "@ProjectVersion@" project_version
+                . replace "@ProjectVersionMunged@" project_version_munged
+                . replace "@Cabal64bit@" (cabal_bool (target_word_size == 8))
+                . replace "@CabalMingwex@" (cabal_bool lib_mingwex)
+                . replace "@CabalHaveLibdw@" (cabal_bool lib_dw)
+                . replace "@CabalHaveLibm@" (cabal_bool lib_m)
+                . replace "@CabalHaveLibrt@" (cabal_bool lib_rt)
+                . replace "@CabalHaveLibdl@" (cabal_bool lib_dl)
+                . replace "@CabalUseSystemLibFFI@" (cabal_bool lib_ffi)
+                . replace "@CabalLibffiAdjustors@" (cabal_bool lib_ffi_adjustors)
+                . replace "@CabalNeedLibpthread@" (cabal_bool lib_pthread)
+                . replace "@CabalHaveLibbfd@" (cabal_bool lib_bfd)
+                . replace "@CabalHaveLibNuma@" (cabal_bool lib_numa)
+                . replace "@CabalLeadingUnderscore@" (cabal_bool leading_underscore)
+                . replace "@CabalNeedLibatomic@" (cabal_bool need_libatomic)
+
+    s <- readFile' (out <.> "in")
+    writeFile' out (subst s)
+    putSuccess ("| Successfully generated " ++ out ++ " from its template")
+
 -- Generators
 
 -- | GHC wrapper scripts used for passing the path to the right package database
@@ -353,7 +420,7 @@ generateSettings = do
         , ("Tables next to code", expr $ yesNo <$> flag TablesNextToCode)
         , ("Leading underscore", expr $ yesNo <$> flag LeadingUnderscore)
         , ("Use LibFFI", expr $ yesNo <$> useLibffiForAdjustors)
-        , ("RTS expects libdw", yesNo <$> getFlag WithLibdw)
+        , ("RTS expects libdw", yesNo <$> getFlag UseLibdw)
         ]
     let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
     pure $ case settings of


=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -403,8 +403,8 @@ rtsPackageArgs = package rts ? do
         , builder HsCpp ? pure
           [ "-DTOP="             ++ show top ]
 
-        , builder HsCpp ? flag WithLibdw ? arg "-DUSE_LIBDW"
-        , builder HsCpp ? flag HaveLibMingwEx ? arg "-DHAVE_LIBMINGWEX" ]
+        , builder HsCpp ? flag UseLibdw ? arg "-DUSE_LIBDW"
+        , builder HsCpp ? flag UseLibmingwex ? arg "-DHAVE_LIBMINGWEX" ]
 
 -- Compile various performance-critical pieces *without* -fPIC -dynamic
 -- even when building a shared library.  If we don't do this, then the


=====================================
libraries/base/Foreign/C/Types.hs
=====================================
@@ -86,8 +86,11 @@ module Foreign.C.Types
 
           -- Instances of: Eq and Storable
         , CFile,        CFpos,     CJmpBuf
+
+        , ConstPtr(..)
         ) where
 
+import Foreign.Ptr      ( Ptr )
 import Foreign.Storable
 import Data.Bits        ( Bits(..), FiniteBits(..) )
 import Data.Int         ( Int8,  Int16,  Int32,  Int64  )
@@ -223,6 +226,9 @@ INTEGRAL_TYPE(CUIntPtr,"uintptr_t",HTYPE_UINTPTR_T)
 INTEGRAL_TYPE(CIntMax,"intmax_t",HTYPE_INTMAX_T)
 INTEGRAL_TYPE(CUIntMax,"uintmax_t",HTYPE_UINTMAX_T)
 
+-- | Used to produce 'const' qualifier in C code generator
+newtype ConstPtr a = ConstPtr { unConstPtr :: Ptr a } deriving newtype (Show, Eq, Storable)
+
 -- C99 types which are still missing include:
 -- wint_t, wctrans_t, wctype_t
 


=====================================
m4/fp_bfd_support.m4
=====================================
@@ -2,7 +2,7 @@
 # ----------------------
 # whether to use libbfd for debugging RTS
 AC_DEFUN([FP_BFD_SUPPORT], [
-    AC_SUBST([CabalHaveLibbfd], [False])
+    HaveLibbfd=NO
     AC_ARG_ENABLE(bfd-debug,
         [AS_HELP_STRING([--enable-bfd-debug],
               [Enable symbol resolution for -debug rts ('+RTS -Di') via binutils' libbfd [default=no]])],
@@ -40,9 +40,10 @@ AC_DEFUN([FP_BFD_SUPPORT], [
                                     bfd_get_symbol_info(abfd,symbol_table[0],&info);
                                 }
                         ]])],
-                        [AC_SUBST([CabalHaveLibbfd], [True])],dnl bfd seems to work
+                        HaveLibbfd=YES,dnl bfd seems to work
                         [AC_MSG_ERROR([can't use 'bfd' library])])
             LIBS="$save_LIBS"
         ]
     )
+    AC_SUBST([UseLibbfd],[$HaveLibbfd])
 ])


=====================================
m4/fp_cc_supports__atomics.m4
=====================================
@@ -63,9 +63,9 @@ AC_DEFUN([FP_CC_SUPPORTS__ATOMICS],
     ])
     AC_DEFINE([HAVE_C11_ATOMICS], [1], [Does C compiler support __atomic primitives?])
     if test "$need_latomic" = 1; then
-        AC_SUBST([CabalNeedLibatomic],[True])
+        AC_SUBST([NeedLibatomic],[YES])
     else
-        AC_SUBST([CabalNeedLibatomic],[False])
+        AC_SUBST([NeedLibatomic],[NO])
     fi
     AC_DEFINE_UNQUOTED([NEED_ATOMIC_LIB], [$need_latomic],
         [Define to 1 if we need -latomic.])


=====================================
m4/fp_check_pthreads.m4
=====================================
@@ -12,18 +12,18 @@ AC_DEFUN([FP_CHECK_PTHREADS],
   AC_CHECK_FUNC(pthread_create,
       [
           AC_MSG_RESULT(no)
-          AC_SUBST([CabalNeedLibpthread],[False])
+          AC_SUBST([UseLibpthread],[NO])
           need_lpthread=0
       ],
       [
           AC_CHECK_LIB(pthread, pthread_create,
               [
                   AC_MSG_RESULT(yes)
-                  AC_SUBST([CabalNeedLibpthread],[True])
+                  AC_SUBST([UseLibpthread],[YES])
                   need_lpthread=1
               ],
               [
-                  AC_SUBST([CabalNeedLibpthread],[False])
+                  AC_SUBST([UseLibpthread],[NO])
                   AC_MSG_RESULT([no pthreads support found.])
                   need_lpthread=0
               ])


=====================================
rts/RtsFlags.c
=====================================
@@ -2373,6 +2373,10 @@ static void read_trace_flags(const char *arg)
             RtsFlags.TraceFlags.sparks_sampled = enabled;
             RtsFlags.TraceFlags.sparks_full    = enabled;
             RtsFlags.TraceFlags.user           = enabled;
+            RtsFlags.TraceFlags.nonmoving_gc   = enabled;
+#if defined(TICKY_TICKY)
+            RtsFlags.TraceFlags.ticky          = enabled;
+#endif
             enabled = true;
             break;
 


=====================================
testsuite/tests/ffi/should_compile/T22034.h
=====================================
@@ -0,0 +1,2 @@
+const int *foo();
+const double *bar;


=====================================
testsuite/tests/ffi/should_compile/T22034.hs
=====================================
@@ -0,0 +1,10 @@
+{-# LANGUAGE CApiFFI #-}
+module T22034 where
+
+import Foreign.C.Types
+
+foreign import capi "T22034.h foo"
+    c_foo :: IO (ConstPtr CInt)
+
+foreign import capi "T22034.h value bar"
+    c_bar :: ConstPtr CDouble


=====================================
testsuite/tests/ffi/should_compile/T22034_c.c
=====================================
@@ -0,0 +1,9 @@
+#include <stdlib.h>
+
+const int * foo() {
+    int *x = malloc(sizeof(int));
+    *x = 42;
+    return x;
+}
+
+const int *bar = 0;


=====================================
testsuite/tests/ffi/should_compile/all.T
=====================================
@@ -43,3 +43,4 @@ test(
     ],
 )
 test('T15531', normal, compile, ['-Wall'])
+test('T22034', [omit_ways(['ghci'])], compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0727c2934c1bf09dc247ebb8eecdd02b09d8272...66dc3992060adcfa4a47ef3d2a55e1a48548c9f7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b0727c2934c1bf09dc247ebb8eecdd02b09d8272...66dc3992060adcfa4a47ef3d2a55e1a48548c9f7
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/20221123/b24a99d7/attachment-0001.html>


More information about the ghc-commits mailing list