[Git][ghc/ghc][wip/reinstallable-th] 3 commits: Rename modules moved to ghc-internal to start with GHC.Internal

Teo Camarasu (@teo) gitlab at gitlab.haskell.org
Wed May 8 15:53:39 UTC 2024



Teo Camarasu pushed to branch wip/reinstallable-th at Glasgow Haskell Compiler / GHC


Commits:
cc9d45e9 by Teo Camarasu at 2024-05-08T16:50:29+01:00
Rename modules moved to ghc-internal to start with GHC.Internal

We re-expose the old names from ghc-boot-th for backcompat

- - - - -
cebad7d2 by Teo Camarasu at 2024-05-08T16:52:58+01:00
Update docs

- - - - -
35fa7bba by Teo Camarasu at 2024-05-08T16:53:13+01:00
mark as safe

- - - - -


19 changed files:

- compiler/GHC/Rename/Splice.hs
- libraries/base/src/Data/Fixed.hs
- + libraries/ghc-boot-th/GHC/ForeignSrcLang/Type.hs
- + libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
- + libraries/ghc-boot-th/GHC/Lexeme.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-internal/ghc-internal.cabal
- libraries/ghc-internal/src/GHC/ForeignSrcLang/Type.hs → libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/LanguageExtensions/Type.hs → libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- libraries/ghc-internal/src/GHC/Lexeme.hs → libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
- libraries/template-haskell/Language/Haskell/TH/Ppr.hs
- libraries/template-haskell/Language/Haskell/TH/PprLib.hs
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs


Changes:

=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -590,7 +590,7 @@ problems. Consider the following code:
   module X where
 
   import Prelude ( Monad(..), Bool(..), print, ($) )
-  import GHC.Internal.TH.Syntax
+  import Language.Haskell.TH.Syntax
 
   $( do stuff <- [| if True then 10 else 15 |]
         runIO $ print stuff
@@ -620,7 +620,7 @@ following code is expected to be rejected (because of the lack of suitable
   module X where
 
   import Prelude ( Monad(..), Bool(..), print, ($) )
-  import GHC.Internal.TH.Syntax
+  import Language.Haskell.TH.Syntax
 
   $$( do stuff <- [|| if True then 10 else 15 ||]
          runIO $ print stuff


=====================================
libraries/base/src/Data/Fixed.hs
=====================================
@@ -140,6 +140,7 @@ instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
     dataTypeOf _ = tyFixed
     toConstr _ = conMkFixed
 
+-- @since 2.19.0.0
 instance TH.Lift (Fixed a) where
   liftTyped x = TH.unsafeCodeCoerce (TH.lift x)
   lift (MkFixed x) = [| MkFixed x |]


=====================================
libraries/ghc-boot-th/GHC/ForeignSrcLang/Type.hs
=====================================
@@ -0,0 +1,5 @@
+module GHC.ForeignSrcLang.Type
+  ( ForeignSrcLang(..)
+  ) where
+
+import GHC.Internal.ForeignSrcLang


=====================================
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
=====================================
@@ -0,0 +1,14 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.LanguageExtensions.Type
+-- Copyright   :  (c) The GHC Team
+--
+-- Maintainer  :  ghc-devs at haskell.org
+-- Portability :  portable
+--
+-- A data type defining the language extensions supported by GHC.
+--
+{-# LANGUAGE Safe #-}
+module GHC.LanguageExtensions.Type ( Extension(..) ) where
+
+import GHC.Internal.LanguageExtensions


=====================================
libraries/ghc-boot-th/GHC/Lexeme.hs
=====================================
@@ -0,0 +1,18 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Lexeme
+-- Copyright   :  (c) The GHC Team
+--
+-- Maintainer  :  ghc-devs at haskell.org
+-- Portability :  portable
+--
+-- Functions to evaluate whether or not a string is a valid identifier.
+--
+module GHC.Lexeme (
+          -- * Lexical characteristics of Haskell names
+        startsVarSym, startsVarId, startsConSym, startsConId,
+        startsVarSymASCII, isVarSymChar, okSymChar
+  ) where
+
+import GHC.Internal.Lexeme


=====================================
libraries/ghc-boot-th/ghc-boot-th.cabal.in
=====================================
@@ -44,6 +44,9 @@ Library
             GHC.Internal.TH.Lib.Map
             GHC.Internal.TH.Ppr
             GHC.Internal.TH.PprLib
+            GHC.LanguageExtensions.Type
+            GHC.ForeignSrcLang.Type
+            GHC.Lexeme
 
     build-depends:
         base       >= 4.7 && < 4.21,
@@ -54,20 +57,17 @@ Library
         cpp-options: -DBOOTSTRAP_TH
         hs-source-dirs: @SourceRoot@ ../ghc-internal/src
         exposed-modules:
-            GHC.Lexeme
-            GHC.LanguageExtensions.Type
-            GHC.ForeignSrcLang.Type
             GHC.Internal.TH.Syntax
             GHC.Internal.TH.Lib
+            GHC.Internal.LanguageExtensions
+            GHC.Internal.ForeignSrcLang
+            GHC.Internal.Lexeme
     else
         hs-source-dirs: @SourceRoot@
         build-depends:
             ghc-internal
         reexported-modules:
             GHC.Internal.TH.Lib,
-            GHC.LanguageExtensions.Type,
-            GHC.ForeignSrcLang.Type,
             GHC.Internal.TH.Syntax,
-            GHC.Lexeme,
             GHC.Internal.TH.Lift,
             GHC.Internal.TH.Quote


=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -161,6 +161,7 @@ Library
         GHC.Internal.Foreign.Ptr
         GHC.Internal.Foreign.StablePtr
         GHC.Internal.Foreign.Storable
+        GHC.Internal.ForeignSrcLang
         GHC.Internal.Arr
         GHC.Internal.ArrayArray
         GHC.Internal.Base
@@ -230,6 +231,8 @@ Library
         GHC.Internal.Integer.Logarithms
         GHC.Internal.IsList
         GHC.Internal.Ix
+        GHC.Internal.LanguageExtensions
+        GHC.Internal.Lexeme
         GHC.Internal.List
         GHC.Internal.Maybe
         GHC.Internal.MVar
@@ -291,9 +294,6 @@ Library
         GHC.Internal.Unsafe.Coerce
         -- TODO: remove
         GHC.Internal.IOPort
-        GHC.ForeignSrcLang.Type
-        GHC.LanguageExtensions.Type
-        GHC.Lexeme
 
     reexported-modules:
           GHC.Num.Integer


=====================================
libraries/ghc-internal/src/GHC/ForeignSrcLang/Type.hs → libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
=====================================
@@ -1,6 +1,6 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveGeneric #-}
-module GHC.ForeignSrcLang.Type
+module GHC.Internal.ForeignSrcLang
   ( ForeignSrcLang(..)
   ) where
 


=====================================
libraries/ghc-internal/src/GHC/LanguageExtensions/Type.hs → libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
=====================================
@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  GHC.LanguageExtensions.Type
+-- Module      :  GHC.Internal.LanguageExtensions
 -- Copyright   :  (c) The GHC Team
 --
 -- Maintainer  :  ghc-devs at haskell.org
@@ -9,7 +9,7 @@
 -- A data type defining the language extensions supported by GHC.
 --
 {-# LANGUAGE DeriveGeneric, CPP, Trustworthy #-}
-module GHC.LanguageExtensions.Type ( Extension(..) ) where
+module GHC.Internal.LanguageExtensions ( Extension(..) ) where
 
 #ifdef BOOTSTRAP_TH
 import Prelude -- See note [Why do we import Prelude here?]


=====================================
libraries/ghc-internal/src/GHC/Lexeme.hs → libraries/ghc-internal/src/GHC/Internal/Lexeme.hs
=====================================
@@ -1,7 +1,7 @@
 {-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
--- Module      :  GHC.Lexeme
+-- Module      :  GHC.Internal.Lexeme
 -- Copyright   :  (c) The GHC Team
 --
 -- Maintainer  :  ghc-devs at haskell.org
@@ -9,7 +9,7 @@
 --
 -- Functions to evaluate whether or not a string is a valid identifier.
 --
-module GHC.Lexeme (
+module GHC.Internal.Lexeme (
           -- * Lexical characteristics of Haskell names
         startsVarSym, startsVarId, startsConSym, startsConId,
         startsVarSymASCII, isVarSymChar, okSymChar


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
=====================================
@@ -5,12 +5,12 @@
 {-# LANGUAGE Trustworthy #-}
 
 -- |
--- Language.Haskell.TH.Lib.Internal exposes some additional functionality that
+-- GHC.Internal.TH.Lib exposes some additional functionality that
 -- is used internally in GHC's integration with Template Haskell. This is not a
 -- part of the public API, and as such, there are no API guarantees for this
 -- module from version to version.
 
--- Why do we have both Language.Haskell.TH.Lib.Internal and
+-- Why do we have both GHC.Internal.TH.Lib and
 -- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
 -- former (which are tailored for GHC's use) need different type signatures
 -- than the ones in the latter. Syncing up the Internal type signatures would


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -14,10 +14,32 @@
 {-# LANGUAGE UnboxedTuples #-}
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
 
-module GHC.Internal.TH.Lift where
+-- | This module gives the definition of the 'Lift' class.
+--
+-- This is an internal module.
+-- Please import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
+
+module GHC.Internal.TH.Lift
+  ( Lift(..)
+  , liftString
+  -- * Wired-in names
+  , trueName
+  , falseName
+  , nothingName
+  , justName
+  , leftName
+  , rightName
+  , nonemptyName
+  -- * Generic Lift implementations
+  , dataToQa
+  , dataToExpQ
+  , liftData
+  , dataToPatQ
+  )
+  where
 
 import GHC.Internal.TH.Syntax
-import GHC.Lexeme       ( startsVarSym, startsVarId )
+import GHC.Internal.Lexeme ( startsVarSym, startsVarId )
 
 import GHC.Internal.Data.Either
 import GHC.Internal.Type.Reflection
@@ -32,14 +54,6 @@ import GHC.Internal.Int
 import GHC.Internal.Data.Data
 import GHC.Internal.Natural
 
--- See Note [Bootstrapping Template Haskell]
-
------------------------------------------------------
---
---              The Lift class
---
------------------------------------------------------
-
 -- | A 'Lift' instance can have any of its values turned into a Template
 -- Haskell expression. This is needed when a value used within a Template
 -- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or
@@ -186,10 +200,6 @@ instance Lift Addr# where
   lift x
     = return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
 
--- TODO: move this somewhere else
--- |
--- @since 2.19.0.0
-
 instance Lift a => Lift (Maybe a) where
   liftTyped x = unsafeCodeCoerce (lift x)
 


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
=====================================
@@ -12,6 +12,8 @@ quasiquoter @q@ which can be invoked using the syntax
 extension is enabled, and some utility functions for manipulating
 quasiquoters.  Nota bene: this package does not define any parsers,
 that is up to you.
+
+This is an internal module. Please import 'Language.Haskell.TH.Quote' instead.
 -}
 module GHC.Internal.TH.Quote(
         QuasiQuoter(..),


=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
=====================================
@@ -20,7 +20,7 @@
 module GHC.Internal.TH.Syntax
     ( module GHC.Internal.TH.Syntax
       -- * Language extensions
-    , module GHC.LanguageExtensions.Type
+    , module GHC.Internal.LanguageExtensions
     , ForeignSrcLang(..)
     -- * Notes
     -- ** Unresolved Infix
@@ -78,8 +78,8 @@ import GHC.Internal.IO.Exception
 import GHC.Internal.Unicode
 import qualified GHC.Types as Kind (Type)
 #endif
-import GHC.ForeignSrcLang.Type
-import GHC.LanguageExtensions.Type
+import GHC.Internal.ForeignSrcLang
+import GHC.Internal.LanguageExtensions
 
 -----------------------------------------------------
 --


=====================================
libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
=====================================
@@ -1,4 +1,18 @@
-{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE Safe #-}
+-- |
+-- Language.Haskell.TH.Lib.Internal exposes some additional functionality that
+-- is used internally in GHC's integration with Template Haskell. This is not a
+-- part of the public API, and as such, there are no API guarantees for this
+-- module from version to version.
+
+-- Why do we have both GHC.Internal.TH.Lib and
+-- Language.Haskell.TH.Lib? Ultimately, it's because the functions in the
+-- former (which are tailored for GHC's use) need different type signatures
+-- than the ones in the latter. Syncing up the Internal type signatures would
+-- involve a massive amount of breaking changes, so for the time being, we
+-- relegate as many changes as we can to just the Internal module, where it
+-- is safe to break things.
+
 module Language.Haskell.TH.Lib.Internal
   ( module GHC.Internal.TH.Lib )
   where


=====================================
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -1,4 +1,7 @@
 {-# LANGUAGE Safe #-}
+
+-- | contains a prettyprinter for the
+-- Template Haskell datatypes
 module Language.Haskell.TH.Ppr
   ( module GHC.Internal.TH.Ppr )
   where


=====================================
libraries/template-haskell/Language/Haskell/TH/PprLib.hs
=====================================
@@ -1,4 +1,6 @@
 {-# LANGUAGE Safe #-}
+
+-- | Monadic front-end to Text.PrettyPrint
 module Language.Haskell.TH.PprLib
   ( module GHC.Internal.TH.PprLib )
   where


=====================================
libraries/template-haskell/Language/Haskell/TH/Quote.hs
=====================================
@@ -1,4 +1,18 @@
 {-# LANGUAGE Safe #-}
+{- |
+Module : Language.Haskell.TH.Quote
+Description : Quasi-quoting support for Template Haskell
+
+Template Haskell supports quasiquoting, which permits users to construct
+program fragments by directly writing concrete syntax.  A quasiquoter is
+essentially a function with takes a string to a Template Haskell AST.
+This module defines the 'QuasiQuoter' datatype, which specifies a
+quasiquoter @q@ which can be invoked using the syntax
+@[q| ... string to parse ... |]@ when the @QuasiQuotes@ language
+extension is enabled, and some utility functions for manipulating
+quasiquoters.  Nota bene: this package does not define any parsers,
+that is up to you.
+-}
 module Language.Haskell.TH.Quote
   (module GHC.Internal.TH.Quote)
   where


=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -9,16 +9,16 @@ import GHC.Internal.TH.Syntax
 import GHC.Internal.TH.Lift
 import System.FilePath
 
--- The only difference between this module and GHC.Internal.TH.Syntax
--- (which it reexports fully) is that this module depends on the
--- Internal.TH.Lib module.
+-- This module completely re-exports 'GHC.Internal.TH.Syntax', and exports
+-- functions that depend on filepath.
 --
+-- Additionally it re-exports 'GHC.Internal.TH.Lift', which depends on
+-- 'GHC.Internal.TH.Lib'.
 -- We did this to fix #22229: a module importing the Syntax module to use
 -- DeriveLift (Lift is defined there) would lead GHC to load the
 -- interface file for the Internal module (where wired-in TH things live),
 -- but the Internal module might not be built yet at this point. Adding an
--- explicit dependency from Syntax to Internal fixes this. We do this with a
--- module reexport because Internal actually depends on Syntax.
+-- explicit dependency from Syntax to Lift fixes this.
 --
 -- See Note [Tracking dependencies on primitives] in GHC.Internal.Base, wrinkle W4.
 import GHC.Internal.TH.Lib ()



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d007d7f99289b1d451647bb01070c1a557a77c8...35fa7bba8b2e9bed1e51bc2e40940463d1dcfb67

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4d007d7f99289b1d451647bb01070c1a557a77c8...35fa7bba8b2e9bed1e51bc2e40940463d1dcfb67
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/20240508/619247cc/attachment-0001.html>


More information about the ghc-commits mailing list