[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: rts: fix missing function prototypes in ClosureMacros.h

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue May 28 20:25:02 UTC 2024



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


Commits:
688e0d95 by Cheng Shao at 2024-05-28T16:24:45-04:00
rts: fix missing function prototypes in ClosureMacros.h

- - - - -
80b28191 by Andreas Klebinger at 2024-05-28T16:24:45-04:00
UnliftedFFITypes: Allow `(# #)` as argument when it's the only argument.

This allows representing functions like:

    int foo(void);

to be imported like this:

    foreign import ccall "a_number_c"
      c_number :: (# #) -> Int64#

Which can be useful when the imported function isn't implicitly
stateful.

- - - - -
5fe7d90a by Matthew Pickering at 2024-05-28T16:24:45-04:00
ci: Update ci-images commit for fedora38 image

The fedora38 nightly job has been failing for quite a while because
`diff` was no longer installed. The ci-images bump explicitly installs
`diffutils` into these images so hopefully they now pass again.

- - - - -
727b62c7 by Jan Hrček at 2024-05-28T16:24:50-04:00
Update exactprint docs

- - - - -
585baa5c by Jan Hrček at 2024-05-28T16:24:50-04:00
Incorporate review feedback

- - - - -
4bbd5e8b by Jan Hrček at 2024-05-28T16:24:50-04:00
Remove no longer relevant reference to comments

- - - - -
75026f2c by Jan Hrček at 2024-05-28T16:24:50-04:00
Replace outdated code example

- - - - -
0e95a643 by Andreas Klebinger at 2024-05-28T16:24:50-04:00
Reword error resulting from missing -XBangPatterns.

It can be the result of either a bang pattern or strict binding,
so now we say so instead of claiming it must be a bang pattern.

Fixes #21032

- - - - -
7e50e48a by Cheng Shao at 2024-05-28T16:24:51-04:00
testsuite: bump MultiLayerModulesDefsGhciReload timeout to 10x

- - - - -


20 changed files:

- .gitlab-ci.yml
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Types/SrcLoc.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/ffi.rst
- rts/include/rts/storage/ClosureMacros.h
- + testsuite/tests/ffi/should_run/T24818.hs
- + testsuite/tests/ffi/should_run/T24818.stdout
- + testsuite/tests/ffi/should_run/T24818_c.c
- + testsuite/tests/ffi/should_run/T24818_cmm.cmm
- testsuite/tests/ffi/should_run/all.T
- testsuite/tests/parser/should_fail/T14588.stderr
- testsuite/tests/parser/should_fail/T16270.stderr
- testsuite/tests/parser/should_fail/T17162.stderr
- testsuite/tests/parser/should_fail/proposal-229c.stderr
- testsuite/tests/perf/compiler/all.T


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: 064e90c26dffe5709bd5b87dbd211b9a8b21fc5b
+  DOCKER_REV: dbbc0f6f5b73930ead052ca8161e969f1755eed7
 
   # Sequential version number of all cached things.
   # Bump to invalidate GitLab CI cache.


=====================================
compiler/GHC/Core/TyCon.hs
=====================================
@@ -1564,6 +1564,7 @@ data PrimRep
 
 data PrimOrVoidRep = VoidRep | NVRep PrimRep
   -- See Note [VoidRep] in GHC.Types.RepType
+  deriving (Data.Data, Eq, Ord, Show)
 
 data PrimElemRep
   = Int8ElemRep


=====================================
compiler/GHC/HsToCore/Foreign/Call.hs
=====================================
@@ -47,6 +47,7 @@ import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
 import Data.Maybe
+import GHC.Types.RepType (typePrimRep1)
 
 {-
 Desugaring of @ccall at s consists of adding some state manipulation,
@@ -137,7 +138,9 @@ unboxArg :: CoreExpr                    -- The supplied argument, not representa
 
 unboxArg arg
   -- Primitive types: nothing to unbox
-  | isPrimitiveType arg_ty
+  | isPrimitiveType arg_ty ||
+    -- Same for (# #)
+    (isUnboxedTupleType arg_ty && typePrimRep1 arg_ty == VoidRep)
   = return (arg, \body -> body)
 
   -- Recursive newtypes


=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -485,9 +485,9 @@ instance Outputable AddEpAnn where
 -- ---------------------------------------------------------------------
 
 -- | The exact print annotations (EPAs) are kept in the HsSyn AST for
---   the GhcPs phase. We do not always have EPAs though, only for code
---   that has been parsed as they do not exist for generated
---   code. This type captures that they may be missing.
+--   the GhcPs phase. They are usually inserted into the AST by the parser,
+--   and in case of generated code (e.g. by TemplateHaskell) they are usually
+--   initialized using 'NoAnn' type class.
 --
 -- A goal of the annotations is that an AST can be edited, including
 -- moving subtrees from one place to another, duplicating them, and so
@@ -501,19 +501,19 @@ instance Outputable AddEpAnn where
 --
 -- The 'ann' type parameter allows this general structure to be
 -- specialised to the specific set of locations of original exact
--- print annotation elements.  So for 'HsLet' we have
+-- print annotation elements.  For example
 --
---    type instance XLet GhcPs = EpAnn AnnsLet
---    data AnnsLet
---      = AnnsLet {
---          alLet :: EpaLocation,
---          alIn :: EpaLocation
---          } deriving Data
+-- @
+-- type SrcSpannAnnA = EpAnn AnnListItem
+-- @
+--
+-- is a commonly used type alias that specializes the 'ann' type parameter to
+-- 'AnnListItem'.
 --
 -- The spacing between the items under the scope of a given EpAnn is
 -- normally derived from the original 'Anchor'.  But if a sub-element
 -- is not in its original position, the required spacing can be
--- directly captured in the 'anchor_op' field of the 'entry' Anchor.
+-- captured using an appropriate 'EpaDelta' value for the 'entry' Anchor.
 -- This allows us to freely move elements around, and stitch together
 -- new AST fragments out of old ones, and have them still printed out
 -- in a precise way.
@@ -535,7 +535,7 @@ data EpAnn ann
 -- annotations.
 -- It is also normally used as the reference point for the spacing of
 -- the element relative to its container. If the AST element is moved,
--- that relationship is tracked in the 'anchor_op' instead.
+-- that relationship is tracked using the 'EpaDelta' constructor instead.
 type Anchor = EpaLocation -- Transitional
 
 anchor :: (EpaLocation' a) -> RealSrcSpan
@@ -553,7 +553,7 @@ noSpanAnchor =  EpaDelta (SameLine 0) noAnn
 
 -- ---------------------------------------------------------------------
 
--- | When we are parsing we add comments that belong a particular AST
+-- | When we are parsing we add comments that belong to a particular AST
 -- element, and print them together with the element, interleaving
 -- them into the output stream.  But when editing the AST to move
 -- fragments around it is useful to be able to first separate the
@@ -602,9 +602,9 @@ Note [XRec and Anno in the AST]
 
 The exact print annotations are captured directly inside the AST, using
 TTG extension points. However certain annotations need to be captured
-on the Located versions too.  While there is a general form for these,
-captured in the type SrcSpanAnn', there are also specific usages in
-different contexts.
+on the Located versions too.  There is a general form for these,
+captured in the type 'EpAnn ann' with the specific usage captured in
+the 'ann' parameter in different contexts.
 
 Some of the particular use cases are
 
@@ -615,7 +615,7 @@ to its usage inside a list.
 
 See the section above this note for the rest.
 
-The Anno type family maps the specific SrcSpanAnn' variant for a given
+The Anno type family maps to the specific EpAnn variant for a given
 item.
 
 So
@@ -639,7 +639,7 @@ data TrailingAnn
   | AddCommaAnn   { ta_location :: EpaLocation }  -- ^ Trailing ','
   | AddVbarAnn    { ta_location :: EpaLocation }  -- ^ Trailing '|'
   | AddDarrowAnn  { ta_location :: EpaLocation }  -- ^ Trailing '=>'
-  | AddDarrowUAnn { ta_location :: EpaLocation }  -- ^ Trailing  "⇒"
+  | AddDarrowUAnn { ta_location :: EpaLocation }  -- ^ Trailing '⇒'
   deriving (Data, Eq)
 
 instance Outputable TrailingAnn where
@@ -730,7 +730,7 @@ data NameAnn
       nann_close     :: EpaLocation,
       nann_trailing  :: [TrailingAnn]
       }
-  -- | Used for @(,,,)@, or @(#,,,#)#
+  -- | Used for @(,,,)@, or @(#,,,#)@
   | NameAnnCommas {
       nann_adornment :: NameAdornment,
       nann_open      :: EpaLocation,
@@ -769,7 +769,7 @@ data NameAnn
       nann_trailing  :: [TrailingAnn]
       }
   -- | Used when adding a 'TrailingAnn' to an existing 'LocatedN'
-  -- which has no Api Annotation (via the 'EpAnnNotUsed' constructor.
+  -- which has no Api Annotation.
   | NameAnnTrailing {
       nann_trailing  :: [TrailingAnn]
       }
@@ -893,7 +893,7 @@ So for the first example we have
 
   binds: fa = 1 , fb = 'c'
   sigs:  fa :: Int, fb :: Char
-  tags: SigTag, BindTag, SigTag, BindTag
+  tags: SigDTag, BindTag, SigDTag, BindTag
 
 so we draw first from the signatures, then the binds, and same again.
 
@@ -901,7 +901,7 @@ For the second example we have
 
   binds: fb = 'c', fa = 1
   sigs:  fa :: Int, fb :: Char
-  tags: SigTag, SigTag, BindTag, BindTag
+  tags: SigDTag, SigDTag, BindTag, BindTag
 
 so we draw two signatures, then two binds.
 


=====================================
compiler/GHC/Parser/Errors/Ppr.hs
=====================================
@@ -202,7 +202,7 @@ instance Diagnostic PsMessage where
              NumUnderscore_Integral -> "Illegal underscores in integer literals"
              NumUnderscore_Float    -> "Illegal underscores in floating literals"
     PsErrIllegalBangPattern e
-      -> mkSimpleDecorated $ text "Illegal bang-pattern" $$ ppr e
+      -> mkSimpleDecorated $ text "Illegal bang-pattern or strict binding" $$ ppr e
     PsErrOverloadedRecordDotInvalid
       -> mkSimpleDecorated $
            text "Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)"


=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -85,6 +85,7 @@ import Control.Monad.Trans.Class
   ( lift )
 import Data.Maybe (isJust)
 import GHC.Builtin.Types (unitTyCon)
+import GHC.Types.RepType (typePrimRep1)
 
 -- Defines a binding
 isForeignImport :: forall name. UnXRec name => LForeignDecl name -> Bool
@@ -297,7 +298,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh l@(CLabel
        return (CImport src (L lc cconv') safety mh l)
 
 tcCheckFIType arg_tys res_ty idecl@(CImport src (L lc cconv) safety mh CWrapper) = do
-        -- Foreign wrapper (former f.e.d.)
+        -- Foreign wrapper (former foreign export dynamic)
         -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
         -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.
         -- The use of the latter form is DEPRECATED, though.
@@ -463,6 +464,21 @@ tcCheckFEType sig_ty edecl@(CExport src (L l (CExportStatic esrc str cconv))) =
 
 ------------ Checking argument types for foreign import ----------------------
 checkForeignArgs :: (Type -> Validity' IllegalForeignTypeReason) -> [Scaled Type] -> TcM ()
+checkForeignArgs _pred [(Scaled mult ty)]
+  -- If there is a single argument allow:
+  --    foo :: (# #) -> T
+  | isUnboxedTupleType ty
+  , VoidRep <- typePrimRep1 ty
+  = do
+    checkNoLinearFFI mult
+    dflags <- getDynFlags
+    case (validIfUnliftedFFITypes dflags) of
+      IsValid -> checkNoLinearFFI mult
+      NotValid needs_uffi -> addErrTc $
+        TcRnIllegalForeignType
+          (Just Arg)
+          (TypeCannotBeMarshaled ty needs_uffi)
+  -- = check (validIfUnliftedFFITypes dflags) (TypeCannotBeMarshaled (Just Arg)) >> checkNoLinearFFI mult
 checkForeignArgs pred tys = mapM_ go tys
   where
     go (Scaled mult ty) = checkNoLinearFFI mult >>


=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -908,15 +908,12 @@ mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b)
 -- ---------------------------------------------------------------------
 
 
--- | The anchor for an @'AnnKeywordId'@. The Parser inserts the
+-- | The anchor for an exact print annotation. The Parser inserts the
 -- @'EpaSpan'@ variant, giving the exact location of the original item
 -- in the parsed source.  This can be replaced by the @'EpaDelta'@
 -- version, to provide a position for the item relative to the end of
 -- the previous item in the source.  This is useful when editing an
--- AST prior to exact printing the changed one. The list of comments
--- in the @'EpaDelta'@ variant captures any comments between the prior
--- output and the thing being marked here, since we cannot otherwise
--- sort the relative order.
+-- AST prior to exact printing the changed one.
 
 data EpaLocation' a = EpaSpan !SrcSpan
                     | EpaDelta !DeltaPos !a


=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -32,6 +32,9 @@ Language
 - Unboxed Float#/Double# literals now support the HexFloatLiterals extension
   (`#22155 <https://gitlab.haskell.org/ghc/ghc/-/issues/22155>`_).
 
+- UnliftedFFITypes: GHC will now accept ffi types like: ``(# #) -> T`` where ``(# #)``
+  is used as the one and only function argument.
+
 Compiler
 ~~~~~~~~
 


=====================================
docs/users_guide/exts/ffi.rst
=====================================
@@ -121,9 +121,13 @@ Unlifted FFI Types
 The following unlifted unboxed types may be used as basic foreign
 types (see FFI Chapter, Section 8.6) for both ``safe`` and
 ``unsafe`` foreign calls: ``Int#``, ``Word#``, ``Char#``, ``Float#``,
-``Double#``, ``Addr#``, and ``StablePtr# a``. Several unlifted boxed
-types may be used as arguments to FFI calls, subject to these
-restrictions:
+``Double#``, ``Addr#``, and ``StablePtr# a``.
+Additionally ``(# #)`` can be used if it's the first and only function argument.
+This allows more flexible importing of functions which don't require ordering
+through IO.
+
+Several unlifted boxed types may be used as arguments to FFI calls,
+subject to these restrictions:
 
 * Valid arguments for ``foreign import unsafe`` FFI calls: ``Array#``,
   ``SmallArray#``, ``ByteArray#``, and the mutable


=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -145,6 +145,18 @@ EXTERN_INLINE StgHalfWord GET_TAG(const StgClosure *con)
    -------------------------------------------------------------------------- */
 
 #if defined(PROFILING)
+
+/*
+  These prototypes are in RtsFlags.h. We can't include RtsFlags.h here
+  because that's a private header, but we do need these prototypes to
+  be duplicated here, otherwise there will be some
+  -Wimplicit-function-declaration compilation errors. Especially when
+  GHC compiles out-of-tree cbits that rely on SET_HDR in RTS API.
+*/
+bool doingLDVProfiling(void);
+bool doingRetainerProfiling(void);
+bool doingErasProfiling(void);
+
 /*
   The following macro works for both retainer profiling and LDV profiling. For
  retainer profiling, we set 'trav' to 0, which is an invalid


=====================================
testsuite/tests/ffi/should_run/T24818.hs
=====================================
@@ -0,0 +1,22 @@
+{-# LANGUAGE GHCForeignImportPrim #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE MagicHash #-}
+
+-- | Test that `foreign import prim` imports handle `State#` in arguments correctly.
+module Main where
+
+-- import GHC.IO
+import GHC.Exts
+import GHC.Int
+
+foreign import prim "a_number_cmm"
+  cmm_number :: (# #) -> Int#
+
+foreign import ccall "a_number_c"
+  c_number :: (# #) -> Int64#
+
+main :: IO ()
+main = do
+  print $ I# (cmm_number (# #))
+  print $ I64# (c_number (# #))


=====================================
testsuite/tests/ffi/should_run/T24818.stdout
=====================================
@@ -0,0 +1,2 @@
+37
+38


=====================================
testsuite/tests/ffi/should_run/T24818_c.c
=====================================
@@ -0,0 +1,8 @@
+#include <stddef.h>
+#include <stdint.h>
+
+int64_t a_number_c(void)
+{
+  return 38;
+}
+


=====================================
testsuite/tests/ffi/should_run/T24818_cmm.cmm
=====================================
@@ -0,0 +1,5 @@
+#include "Cmm.h"
+
+a_number_cmm() {
+    return (37);
+}


=====================================
testsuite/tests/ffi/should_run/all.T
=====================================
@@ -272,3 +272,4 @@ test('T24314',
 test('T24598', req_cmm, compile_and_run, ['T24598_cmm.cmm'])
 test('T24598b', req_cmm, compile_and_run, ['T24598b_cmm.cmm'])
 test('T24598c', req_cmm, compile_and_run, ['T24598c_cmm.cmm'])
+test('T24818', [req_cmm, req_c], compile_and_run, ['-XUnliftedFFITypes T24818_cmm.cmm T24818_c.c'])


=====================================
testsuite/tests/parser/should_fail/T14588.stderr
=====================================
@@ -1,6 +1,6 @@
-
 T14588.hs:4:19: error: [GHC-79767]
-    Illegal bang-pattern
+    Illegal bang-pattern or strict binding
     !x
     Suggested fix:
       Perhaps you intended to use the ‘BangPatterns’ extension
+


=====================================
testsuite/tests/parser/should_fail/T16270.stderr
=====================================
@@ -1,4 +1,3 @@
-
 T16270.hs:3:13: warning: [GHC-53692] [-Wdeprecated-flags (in -Wdefault)]
     -Werror=missing-space-after-bang is deprecated: bang patterns can no longer be written with a space
 
@@ -57,7 +56,7 @@ T16270.hs:24:10: error: [GHC-36952]
       to enable syntax: data T where
 
 T16270.hs:26:12: error: [GHC-79767]
-    Illegal bang-pattern
+    Illegal bang-pattern or strict binding
     !i
     Suggested fix:
       Perhaps you intended to use the ‘BangPatterns’ extension
@@ -90,3 +89,4 @@ T16270.hs:40:7: error: [GHC-71614]
 
 T16270.hs:46:1: error: [GHC-58481]
     parse error (possibly incorrect indentation or mismatched brackets)
+


=====================================
testsuite/tests/parser/should_fail/T17162.stderr
=====================================
@@ -1,6 +1,6 @@
-
 T17162.hs:7:21: error: [GHC-79767]
-    Illegal bang-pattern
+    Illegal bang-pattern or strict binding
     !enc
     Suggested fix:
       Perhaps you intended to use the ‘BangPatterns’ extension
+


=====================================
testsuite/tests/parser/should_fail/proposal-229c.stderr
=====================================
@@ -1,6 +1,6 @@
-
 proposal-229c.hs:6:3: error: [GHC-79767]
-    Illegal bang-pattern
+    Illegal bang-pattern or strict binding
     !x
     Suggested fix:
       Perhaps you intended to use the ‘BangPatterns’ extension
+


=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -436,7 +436,7 @@ test('MultiLayerModulesDefsGhciReload',
      [ collect_compiler_residency(15),
        pre_cmd('./genMultiLayerModulesDefs'),
        extra_files(['genMultiLayerModulesDefs']),
-       compile_timeout_multiplier(5)
+       compile_timeout_multiplier(10)
        # this is _a lot_
        # but this test has been failing every now and then,
        # especially on i386. Let's just give it some room



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e51e40b7c17eb3dfd05354b4475d7e811450c0...7e50e48ac7dc70cfbe27881c80f281506c4c2743

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67e51e40b7c17eb3dfd05354b4475d7e811450c0...7e50e48ac7dc70cfbe27881c80f281506c4c2743
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/20240528/8cade5cc/attachment-0001.html>


More information about the ghc-commits mailing list