[Git][ghc/ghc][ghc-9.6] 6 commits: docs: document permissibility of -XOverloadedLabels (#24249)

Zubin (@wz1000) gitlab at gitlab.haskell.org
Wed Jan 3 22:15:51 UTC 2024



Zubin pushed to branch ghc-9.6 at Glasgow Haskell Compiler / GHC


Commits:
c08f898a by Zubin Duggal at 2024-01-03T13:01:39+05:30
docs: document permissibility of -XOverloadedLabels (#24249)

Document the permissibility introduced by
https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst

(cherry picked from commit c247b6befe6a599688bad0a3383424f7ea12d5f2)

- - - - -
a138877d by Stefan Schulze Frielinghaus at 2024-01-03T13:21:32+05:30
llvmGen: Align objects in the data section

Objects in the data section may be referenced via tagged pointers.
Thus, align those objects to a 4- or 8-byte boundary for 32- or 64-bit
platforms, respectively.  Note, this may need to be reconsidered if
objects with a greater natural alignment requirement are emitted as e.g.
128-bit atomics.

Fixes #24163.

(cherry picked from commit dfe1c3540e4b519b62b862b5966dfec5cae9ece1)

- - - - -
496fbe2e by Ben Gamari at 2024-01-03T13:21:32+05:30
distrib: Rediscover otool and install_name_tool on Darwin

In the bindist configure script we must rediscover the `otool` and
`install_name_tool`s since they may be different from the build
environment.

Fixes #24211.

(cherry picked from commit 292983c841b4facd5c48fcec9689448d66bcb90e)

- - - - -
b8544fe8 by Matthew Craven at 2024-01-03T13:21:32+05:30
Bump bytestring submodule to 0.11.5.3

(cherry picked from commit 97a187bfd713663fccb8bc4f4f0c92792547f9c2)

- - - - -
45c8117a by Zubin Duggal at 2024-01-03T13:21:32+05:30
ci: Ensure we use the correct bindist name for the test artifact when generating
release ghcup metadata

Fixes #24268

(cherry picked from commit 0c555b74f3d9fa92423aebc768c3626a632203a8)

- - - - -
615a63d3 by Zubin Duggal at 2024-01-03T23:40:38+05:30
Update release notes for 9.6.4

Metric Decrease:
    MultiLayerModulesTH_Make

- - - - -


7 changed files:

- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/CmmToLlvm/Data.hs
- distrib/configure.ac.in
- docs/users_guide/9.6.4-notes.rst
- docs/users_guide/exts/overloaded_labels.rst
- libraries/bytestring
- testsuite/tests/ghci/scripts/all.T


Changes:

=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -134,8 +134,14 @@ def mk_one_metadata(release_mode, version, job_map, artifact):
     # In --release-mode, the URL in the metadata needs to point into the downloads folder
     # rather then the pipeline.
     if release_mode:
+        # the test artifact is bundled with the source artifact, so it doesn't have its own job name
+        # So we must manually set the name of the bindist location
+        if artifact == test_artifact:
+            bindist_name = "testsuite"
+        else
+            bindist_name = fetch_gitlab.job_triple(artifact.job_name)
         final_url = release_base.format( version=version
-                                       , bindistName=urllib.parse.quote_plus(f"{fetch_gitlab.job_triple(artifact.job_name)}.tar.xz"))
+                                       , bindistName=urllib.parse.quote_plus(f"{bindist_name}.tar.xz"))
     else:
         final_url = url
 


=====================================
compiler/GHC/CmmToLlvm/Data.hs
=====================================
@@ -89,6 +89,7 @@ genLlvmData (sec, CmmStaticsRaw lbl xs) = do
         align          = case sec of
                             Section CString _ -> if (platformArch platform == ArchS390X)
                                                     then Just 2 else Just 1
+                            Section Data _    -> Just $ platformWordSizeInBytes platform
                             _                 -> Nothing
         const          = if sectionProtection sec == ReadOnlySection
                             then Constant else Global


=====================================
distrib/configure.ac.in
=====================================
@@ -202,6 +202,18 @@ dnl Identify C++ standard library flavour and location
 FP_FIND_CXX_STD_LIB
 AC_CONFIG_FILES([mk/system-cxx-std-lib-1.0.conf])
 
+dnl ** Which otool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([OTOOL], [otool])
+OtoolCmd="$OTOOL"
+AC_SUBST(OtoolCmd)
+
+dnl ** Which install_name_tool to use on macOS
+dnl --------------------------------------------------------------
+AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool])
+InstallNameToolCmd="$INSTALL_NAME_TOOL"
+AC_SUBST(InstallNameToolCmd)
+
 dnl ** Set up the variables for the platform in the settings file.
 dnl May need to use gcc to find platform details.
 dnl --------------------------------------------------------------


=====================================
docs/users_guide/9.6.4-notes.rst
=====================================
@@ -42,6 +42,8 @@ Compiler
   variables (:ghc-ticket:`24083`).
 - Fix a bug where certain warning flags were not recognised (:ghc-ticket:`24071`).
 - Fix an incorrect assertion in the simplifier (:ghc-ticket:`23862`).
+- Align objects in the data section properly when using the LLVM backend
+  (:ghc-ticket:`24163`).
 
 Runtime system
 --------------
@@ -64,6 +66,8 @@ Build system and packaging
   :ghc-ticket:`24033`).
 - Fix a bug where ``-DNOSMP`` wasn't being passed to the C compiler even if the
   target doesn't support SMP (:ghc-ticket:`24082`).
+- Ensure we use the right ``otool`` and ``install_name_tool`` on Darwin
+  (:ghc-ticket:`24211`).
 
 Core libraries
 --------------
@@ -75,6 +79,7 @@ Core libraries
 - Bump ``filepath`` to 1.4.200.1
 - Bump ``unix`` to 2.8.4.0
 - Bump ``haddock`` to 2.29.2
+- Bump ``bytestring`` to 0.11.5.3
 
 Included libraries
 ------------------


=====================================
docs/users_guide/exts/overloaded_labels.rst
=====================================
@@ -91,4 +91,69 @@ showing how an overloaded label can be used as a record selector:
     example = #x (Point 1 2)
 
 
+Since GHC 9.6, any non-empty double quoted string can be used as a label. The
+restriction that the label must be a valid identifier has also been lifted.
 
+Examples of newly allowed syntax:
+
+- Leading capital letters: `#Foo` equivalant to `getLabel @"Foo"`
+
+- Numeric characters: `#3.14` equivalent to `getLabel @"3.14"`
+
+- Arbitrary strings: `#"Hello, World!"` equivalent to `getLabel @"Hello, World!"`
+
+Here is an example of the more permissive use of this extension, available since
+GHC 9.6:
+
+::
+
+    {-# LANGUAGE DataKinds             #-}
+    {-# LANGUAGE MultiParamTypeClasses #-}
+    {-# LANGUAGE OverloadedLabels      #-}
+    {-# LANGUAGE MagicHash             #-}
+
+    import Data.Foldable (traverse_)
+    import Data.Proxy (Proxy(..))
+    import GHC.OverloadedLabels (IsLabel(..))
+    import GHC.TypeLits (KnownSymbol, symbolVal)
+    import GHC.Prim (Addr#)
+
+    instance KnownSymbol symbol => IsLabel symbol String where
+      fromLabel = symbolVal (Proxy :: Proxy symbol)
+
+    (#) :: String -> Int -> String
+    (#) _ i = show i
+
+    f :: Addr# -> Int -> String
+    f _ i = show i
+
+    main :: IO ()
+    main = traverse_ putStrLn
+      [ #a
+      , #number17
+      , #do
+      , #type
+      , #Foo
+      , #3
+      , #199.4
+      , #17a23b
+      , #f'a'
+      , #'a'
+      , #'
+      , #''notTHSplice
+      , #...
+      , #привет
+      , #こんにちは
+      , #"3"
+      , #":"
+      , #"Foo"
+      , #"The quick brown fox"
+      , #"\""
+      , (++) #hello#world
+      , (++) #"hello"#"world"
+      , #"hello"# 1 -- equivalent to `(fromLabel @"hello") # 1`
+      , f "hello"#2 -- equivalent to `f ("hello"# :: Addr#) 2`
+      ]
+
+See `GHC Proposal #170 <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst>`__
+for more details.


=====================================
libraries/bytestring
=====================================
@@ -1 +1 @@
-Subproject commit e377f49b046c986184cf802c8c6386b04c1f1aeb
+Subproject commit 248bab33a07bfbab69f4bfcf853332a59953eeaf


=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -57,7 +57,11 @@ test('ghci024',
 test('T9367',
      [req_interp, when(fast() or config.os != 'mingw32', skip)],
      makefile_test, [])
-test('ghci025', extra_files(['Ghci025B.hs', 'Ghci025C.hs', 'Ghci025D.hs']), ghci_script, ['ghci025.script'])
+test('ghci025',
+     [  extra_files(['Ghci025B.hs', 'Ghci025C.hs', 'Ghci025D.hs']),
+        normalise_version("bytestring")],
+     ghci_script,
+     ['ghci025.script']),
 test('ghci026', extra_files(['../prog002']), ghci_script, ['ghci026.script'])
 
 test('ghci027', [], ghci_script, ['ghci027.script'])
@@ -216,7 +220,7 @@ test('T9762',
  , pre_cmd('$MAKE -s --no-print-directory T9762_prep')
  ],
  ghci_script, ['T9762.script'])
-test('T9881', normal, ghci_script, ['T9881.script'])
+test('T9881', normalise_version("bytestring"), ghci_script, ['T9881.script'])
 test('T9878', [], ghci_script, ['T9878.script'])
 test('T9878b', [extra_run_opts('-fobject-code')], ghci_script,
      ['T9878b.script'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/908c485f27b62961cb2798a373958f5c73734beb...615a63d39ecbeba863199d0447c975ea53a4c84c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/908c485f27b62961cb2798a373958f5c73734beb...615a63d39ecbeba863199d0447c975ea53a4c84c
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/20240103/b3f2047e/attachment-0001.html>


More information about the ghc-commits mailing list