[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