[Git][ghc/ghc][wip/clc216] 2 commits: ghc-internal: Derive version from ghc's version
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Wed Aug 21 16:01:51 UTC 2024
Rodrigo Mesquita pushed to branch wip/clc216 at Glasgow Haskell Compiler / GHC
Commits:
0a79b513 by Rodrigo Mesquita at 2024-08-21T16:59:50+01:00
ghc-internal: Derive version from ghc's version
Fixes #25005
- - - - -
b8a74145 by Ben Gamari at 2024-08-21T16:59:58+01:00
base: Deprecate GHC.Desugar
See https://github.com/haskell/core-libraries-committee/issues/216.
This will be removed in GHC 9.14.
- - - - -
14 changed files:
- .gitignore
- compiler/GHC/Tc/Gen/Splice.hs
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- libraries/base/base.cabal → libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/GHC/Desugar.hs
- libraries/ghc-experimental/ghc-experimental.cabal → libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-heap/ghc-heap.cabal.in
- libraries/ghc-internal/ghc-internal.cabal → libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghci/GHCi/TH.hs
- libraries/ghci/ghci.cabal.in
- m4/fp_setup_project_version.m4
Changes:
=====================================
.gitignore
=====================================
@@ -169,6 +169,9 @@ _darcs/
/libraries/ghc-boot-th-next/ghc-boot-th-next.cabal
/libraries/ghc-boot-th/ghc.mk
/libraries/ghc-heap/ghc-heap.cabal
+/libraries/ghc-internal/ghc-internal.cabal
+/libraries/ghc-experimental/ghc-experimental.cabal
+/libraries/base/base.cabal
/libraries/ghci/GNUmakefile
/libraries/ghci/ghci.cabal
/libraries/ghci/ghc.mk
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -12,6 +12,14 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# LANGUAGE NamedFieldPuns #-}
+#if __GLASGOW_HASKELL__ < 914
+-- In GHC 9.14, GHC.Desugar will be removed from base in favour of
+-- ghc-internal's GHC.Internal.Desugar. However, because of bootstrapping
+-- concerns, we will only depend on ghc-internal when the boot compiler is
+-- certain to have it.
+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
+#endif
+
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
@@ -136,9 +144,8 @@ import qualified GHC.Internal.TH.Syntax as TH
import qualified GHC.Internal.TH.Ppr as TH
#if defined(HAVE_INTERNAL_INTERPRETER)
--- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
-import GHC.Desugar ( AnnotationWrapper(..) )
import Unsafe.Coerce ( unsafeCoerce )
+import GHC.Desugar ( AnnotationWrapper(..) )
#endif
import Control.Monad
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -65,6 +65,7 @@ bootstrap-threaded-rts = @GhcThreadedRts@
project-name = @ProjectName@
project-version = @ProjectVersion@
project-version-munged = @ProjectVersionMunged@
+project-version-for-lib = @ProjectVersionForLib@
project-version-int = @ProjectVersionInt@
project-patch-level = @ProjectPatchLevel@
project-patch-level1 = @ProjectPatchLevel1@
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -66,6 +66,7 @@ data Setting = CursesIncludeDir
| ProjectVersion
| ProjectVersionInt
| ProjectVersionMunged
+ | ProjectVersionForLib
| ProjectPatchLevel
| ProjectPatchLevel1
| ProjectPatchLevel2
@@ -122,6 +123,7 @@ setting key = lookupSystemConfig $ case key of
ProjectName -> "project-name"
ProjectVersion -> "project-version"
ProjectVersionMunged -> "project-version-munged"
+ ProjectVersionForLib -> "project-version-for-lib"
ProjectVersionInt -> "project-version-int"
ProjectPatchLevel -> "project-patch-level"
ProjectPatchLevel1 -> "project-patch-level1"
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -280,11 +280,12 @@ runInterpolations (Interpolations mk_substs) input = do
interpolateSetting :: String -> Setting -> Interpolations
interpolateSetting name settng = interpolateVar name $ setting settng
--- | Interpolate the @ProjectVersion@ and @ProjectVersionMunged@ variables.
+-- | Interpolate the @ProjectVersion@, @ProjectVersionMunged@, and @ProjectVersionForLib@ variables.
projectVersion :: Interpolations
projectVersion = mconcat
[ interpolateSetting "ProjectVersion" ProjectVersion
, interpolateSetting "ProjectVersionMunged" ProjectVersionMunged
+ , interpolateSetting "ProjectVersionForLib" ProjectVersionForLib
]
packageVersions :: Interpolations
@@ -342,6 +343,9 @@ templateRules = do
]
templateRule "libraries/ghci/ghci.cabal" $ projectVersion
templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion
+ templateRule "libraries/ghc-internal/ghc-internal.cabal" $ projectVersion
+ templateRule "libraries/ghc-experimental/ghc-experimental.cabal" $ projectVersion
+ templateRule "libraries/base/base.cabal" $ projectVersion
templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion
templateRule "libraries/template-haskell/template-haskell.cabal" $ mconcat
[ projectVersion
=====================================
libraries/base/base.cabal → libraries/base/base.cabal.in
=====================================
@@ -1,4 +1,8 @@
cabal-version: 3.0
+
+-- WARNING: ghc-experimental.cabal is automatically generated from ghc-experimental.cabal.in
+-- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal
+
name: base
version: 4.20.0.0
-- NOTE: Don't forget to update ./changelog.md
@@ -26,7 +30,7 @@ Library
default-language: Haskell2010
default-extensions: NoImplicitPrelude
build-depends:
- ghc-internal >= 9.1001 && < 9.1002,
+ ghc-internal == @ProjectVersionForLib at .*,
ghc-prim,
exposed-modules:
=====================================
libraries/base/changelog.md
=====================================
@@ -1,6 +1,7 @@
# Changelog for [`base` package](http://hackage.haskell.org/package/base)
## 4.21.0.0 *TBA*
+ * `GHC.Desugar` has been deprecated and should be removed in GHC 9.14. ([CLC proposal #216](https://github.com/haskell/core-libraries-committee/issues/216))
* Add a `readTixFile` field to the `HpcFlags` record in `GHC.RTS.Flags` ([CLC proposal #276](https://github.com/haskell/core-libraries-committee/issues/276))
* Add `compareLength` to `Data.List` and `Data.List.NonEmpty` ([CLC proposal #257](https://github.com/haskell/core-libraries-committee/issues/257))
* Add `INLINE[1]` to `compareInt` / `compareWord` ([CLC proposal #179](https://github.com/haskell/core-libraries-committee/issues/179))
=====================================
libraries/base/src/GHC/Desugar.hs
=====================================
@@ -1,6 +1,8 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
{-# OPTIONS_HADDOCK not-home #-}
+-----------------------------------------------------------------------------
-- |
--
-- Module : GHC.Desugar
@@ -8,7 +10,7 @@
-- License : see libraries/base/LICENSE
--
-- Maintainer : ghc-devs at haskell.org
--- Stability : internal
+-- Stability : deprecated (<https://github.com/haskell/core-libraries-committee/issues/216>)
-- Portability : non-portable (GHC extensions)
--
-- Support code for desugaring in GHC
@@ -18,11 +20,14 @@
-- bound, e.g., @base < 4.X@ rather than @base < 5@, because the interface can
-- change rapidly without much warning.
--
+-----------------------------------------------------------------------------
+
+#if __GLASGOW_HASKELL >= 914
+#error "GHC.Desugar should be removed in GHC 9.14"
+#endif
module GHC.Desugar
- ((>>>),
- AnnotationWrapper(..),
- toAnnotationWrapper
- ) where
+ {-# DEPRECATED ["GHC.Desugar is deprecated and will be removed in GHC 9.14.", "(>>>) should be imported from Control.Arrow.", "AnnotationWrapper is internal to GHC and should not be used externally."] #-}
+ ((>>>), AnnotationWrapper(..), toAnnotationWrapper) where
import GHC.Internal.Desugar
=====================================
libraries/ghc-experimental/ghc-experimental.cabal → libraries/ghc-experimental/ghc-experimental.cabal.in
=====================================
@@ -1,4 +1,8 @@
cabal-version: 3.0
+
+-- WARNING: ghc-experimental.cabal is automatically generated from ghc-experimental.cabal.in
+-- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal
+
name: ghc-experimental
version: 0.1.0.0
synopsis: Experimental features of GHC's standard library
@@ -33,7 +37,7 @@ library
exposed-modules: GHC.Wasm.Prim
other-extensions:
build-depends: base ^>=4.20,
- ghc-internal >= 9.1001 && < 9.1002,
+ ghc-internal == @ProjectVersionForLib at .*,
ghc-prim >= 0.11 && < 0.12
hs-source-dirs: src
default-language: Haskell2010
=====================================
libraries/ghc-heap/ghc-heap.cabal.in
=====================================
@@ -28,7 +28,7 @@ library
, containers >= 0.6.2.1 && < 0.8
if impl(ghc >= 9.9)
- build-depends: ghc-internal >= 9.1001 && < 9.1002
+ build-depends: ghc-internal >= 9.900 && < @ProjectVersionForLib at .99999
ghc-options: -Wall
if !os(ghcjs)
=====================================
libraries/ghc-internal/ghc-internal.cabal → libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -1,6 +1,10 @@
cabal-version: 3.0
+-- WARNING: ghc-internal.cabal is automatically generated from ghc-internal.cabal.in by
+-- the top-level ./configure script. Make sure you are editing ghc-internal.cabal.in, not ghc-internal.cabal.
name: ghc-internal
-version: 9.1001.0
+-- The project is ghc's version plus ghc-internal's version suffix.
+-- For example, for ghc=9.10.1, ghc-internal's version will be 9.1001.0.
+version: @ProjectVersionForLib at .0
license: BSD-3-Clause
license-file: LICENSE
maintainer: The GHC Developers <ghc-devs at haskell.org>
=====================================
libraries/ghci/GHCi/TH.hs
=====================================
@@ -1,6 +1,9 @@
{-# LANGUAGE ScopedTypeVariables, StandaloneDeriving, DeriveGeneric,
TupleSections, RecordWildCards, InstanceSigs, CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}
+-- TODO We want to import GHC.Internal.Desugar instead of GHC.Desugar when we
+-- can require of the bootstrap compiler to have ghc-internal.
-- |
-- Running TH splices
@@ -109,7 +112,7 @@ import Data.IORef
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
-import GHC.Desugar
+import GHC.Desugar (AnnotationWrapper(..))
import qualified GHC.Internal.TH.Syntax as TH
import Unsafe.Coerce
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -85,6 +85,10 @@ library
rts,
array == 0.5.*,
base >= 4.8 && < 4.21,
+ -- ghc-internal == @ProjectVersionForLib at .*
+ -- TODO: Use GHC.Internal.Desugar from ghc-internal instead of ignoring
+ -- the deprecation warning of GHC.Desugar when we require ghc-internal
+ -- of the bootstrap compiler
ghc-prim >= 0.5.0 && < 0.12,
binary == 0.8.*,
bytestring >= 0.10 && < 0.13,
=====================================
m4/fp_setup_project_version.m4
=====================================
@@ -103,4 +103,25 @@ AC_DEFUN([FP_SETUP_PROJECT_VERSION],
ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}"
fi
AC_SUBST([ProjectVersionMunged])
+
+ # The version used for libraries tightly coupled with GHC (e.g.
+ # ghc-internal) which need a major version bump for every minor/patchlevel
+ # GHC version.
+ # Example: for GHC=9.10.1, ProjectVersionForLib=9.1001
+ #
+ # Just like with project version munged, we don't want to use the
+ # patchlevel version which changes every day, so if using GHC HEAD, the
+ # patchlevel = 00.
+ case $VERSION_MINOR in
+ ?) ProjectVersionForLibUpperHalf=${VERSION_MAJOR}.0${VERSION_MINOR} ;;
+ ??) ProjectVersionForLibUpperHalf=${VERSION_MAJOR}.${VERSION_MINOR} ;;
+ *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;;
+ esac
+ # GHC HEAD uses patch level version > 20000000
+ case $ProjectPatchLevel1 in
+ ?) ProjectVersionForLib=${ProjectVersionForLibUpperHalf}0${ProjectPatchLevel1} ;;
+ ??) ProjectVersionInt=${ProjectVersionForLibUpperHalf}${ProjectPatchLevel1} ;;
+ *) ProjectVersionForLib=${ProjectVersionForLibUpperHalf}00
+ esac
+ AC_SUBST([ProjectVersionForLib])
])# FP_SETUP_PROJECT_VERSION
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/686b12305b00c63da9f59994aa6b4d530f3003b1...b8a7414573c9b74688465283b5d3f8dc017cc9b7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/686b12305b00c63da9f59994aa6b4d530f3003b1...b8a7414573c9b74688465283b5d3f8dc017cc9b7
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/20240821/5682a743/attachment-0001.html>
More information about the ghc-commits
mailing list