[Git][ghc/ghc][wip/reinstallable-th] 9 commits: mark as safe
Teo Camarasu (@teo)
gitlab at gitlab.haskell.org
Thu May 9 10:55:37 UTC 2024
Teo Camarasu pushed to branch wip/reinstallable-th at Glasgow Haskell Compiler / GHC
Commits:
789600bf by Teo Camarasu at 2024-05-09T10:55:17+01:00
mark as safe
- - - - -
f3ce3bdd by Teo Camarasu at 2024-05-09T10:55:17+01:00
Update bootstrapping flag doc
- - - - -
dd700c1c by Teo Camarasu at 2024-05-09T10:55:17+01:00
remove accidentally committed file
- - - - -
88b2ec77 by Teo Camarasu at 2024-05-09T10:55:17+01:00
Fix formatting
- - - - -
635bdd20 by Teo Camarasu at 2024-05-09T10:55:17+01:00
Drop ghc-boot-th-next logic
This is no longer necessary as this package is reinstallable
- - - - -
c8225a41 by Teo Camarasu at 2024-05-09T10:59:44+01:00
Make sure to import TH.Lib in TH.Lift!
- - - - -
665b16b3 by Teo Camarasu at 2024-05-09T10:59:44+01:00
Remove redundant import/comment
- - - - -
4c8f8902 by Teo Camarasu at 2024-05-09T11:24:33+01:00
Update Note [Tracking dependencies on primitives]
- - - - -
0feca296 by Teo Camarasu at 2024-05-09T11:35:42+01:00
Move quoteFile to `template-haskell`
- - - - -
17 changed files:
- .gitignore
- compiler/ghc.cabal.in
- hadrian/src/Packages.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/src/Data/Array/Byte.hs
- − libraries/ghc-boot-th/GHC/Internal/TH/Lift.hs
- libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
- libraries/ghc-boot-th/ghc-boot-th.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- libraries/ghci/ghci.cabal.in
- libraries/template-haskell/Language/Haskell/TH/Quote.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
Changes:
=====================================
.gitignore
=====================================
@@ -166,7 +166,6 @@ _darcs/
/libraries/ghc-boot/ghc-boot.cabal
/libraries/ghc-boot-th/GNUmakefile
/libraries/ghc-boot-th/ghc-boot-th.cabal
-/libraries/ghc-boot-th-next/ghc-boot-th-next.cabal
/libraries/ghc-boot-th/ghc.mk
/libraries/ghc-heap/ghc-heap.cabal
/libraries/ghci/GNUmakefile
@@ -183,7 +182,6 @@ _darcs/
/libraries/synopsis.png
/libraries/stamp/
/libraries/template-haskell/template-haskell.cabal
-/libraries/template-haskell-next/template-haskell-next.cabal
/linter.log
/mk/are-validating.mk
/mk/build.mk
=====================================
compiler/ghc.cabal.in
=====================================
@@ -82,15 +82,6 @@ Flag hadrian-stage0
Default: False
Manual: True
-Flag bootstrap
- Description:
- Enabled when building the stage1 compiler in order to vendor the in-tree
- `template-haskell` library (including its dependency `ghc-boot-th`), while
- allowing dependencies to depend on the boot `template-haskell` library.
- See Note [Bootstrapping Template Haskell]
- Default: False
- Manual: True
-
Library
Default-Language: GHC2021
Exposed: False
@@ -130,16 +121,10 @@ Library
semaphore-compat,
stm,
ghc-boot == @ProjectVersionMunged@,
+ ghc-boot-th == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,
ghci == @ProjectVersionMunged@
- if flag(bootstrap)
- Build-Depends:
- ghc-boot-th-next == @ProjectVersionMunged@
- else
- Build-Depends:
- ghc-boot-th == @ProjectVersionMunged@
-
if os(windows)
Build-Depends: Win32 >= 2.3 && < 2.15
else
=====================================
hadrian/src/Packages.hs
=====================================
@@ -4,7 +4,7 @@ module Packages (
array, base, binary, bytestring, cabal, cabalSyntax, checkPpr,
checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
- exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform,
+ exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform,
ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim,
ghcToolchain, ghcToolchainBin, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
@@ -37,7 +37,7 @@ ghcPackages :: [Package]
ghcPackages =
[ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps
, compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls
- , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform
+ , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform
, ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim
, ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs
, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString
@@ -54,7 +54,7 @@ isGhcPackage = (`elem` ghcPackages)
-- | Package definitions, see 'Package'.
array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, countDeps,
compareSizes, compiler, containers, deepseq, deriveConstants, directory, dumpDecls,
- exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThNext, ghcPlatform,
+ exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcPlatform,
ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim,
ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs,
hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy, remoteIserv, libffi, mtl,
@@ -87,7 +87,6 @@ ghc = prg "ghc-bin" `setPath` "ghc"
ghcBignum = lib "ghc-bignum"
ghcBoot = lib "ghc-boot"
ghcBootTh = lib "ghc-boot-th"
-ghcBootThNext = lib "ghc-boot-th-next"
ghcPlatform = lib "ghc-platform"
ghcCompact = lib "ghc-compact"
ghcConfig = prg "ghc-config" `setPath` "testsuite/ghc-config"
=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -142,7 +142,7 @@ toolTargets = [ cabalSyntax
-- , ghc -- # depends on ghc library
-- , runGhc -- # depends on ghc library
, ghcBoot
- , ghcBootThNext
+ , ghcBootTh
, ghcPlatform
, ghcToolchain
, ghcToolchainBin
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -87,7 +87,7 @@ stage0Packages = do
, filepath -- depends on os-string
, ghc
, ghcBoot
- , ghcBootThNext
+ , ghcBootTh
, ghcHeap
, ghcPkg
, ghcPlatform
@@ -126,7 +126,6 @@ stage1Packages = do
| p == unix = False
-- These packages are only needed for bootstrapping.
-- See Note [Bootstrapping Template Haskell]
- | p == ghcBootThNext = False
| otherwise = True
libraries0 <- filter good_stage0_package <$> stage0Packages
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -87,7 +87,6 @@ packageArgs = do
-- We do it through a cabal flag in ghc.cabal
, stageVersion < makeVersion [9,8,1] ? arg "+hadrian-stage0"
, flag StaticLibzstd `cabalFlag` "static-libzstd"
- , stage0 `cabalFlag` "bootstrap"
]
, builder (Haddock BuildPackage) ? arg ("--optghc=-I" ++ path) ]
@@ -122,8 +121,8 @@ packageArgs = do
, builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ?
input "**/cbits/atomic.c" ? arg "-Wno-sync-nand" ]
- -------------------------------- ghcBoot ------------------------------
- , package ghcBoot ?
+ -------------------------------- ghcBootTh ------------------------------
+ , package ghcBootTh ?
builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap")
--------------------------------- ghci ---------------------------------
@@ -160,7 +159,6 @@ packageArgs = do
[ ifM stage0
(andM [cross, bootCross] `cabalFlag` "internal-interpreter")
(arg "internal-interpreter")
- , stage0 `cabalFlag` "bootstrap"
]
]
@@ -186,10 +184,6 @@ packageArgs = do
, package haddock ?
builder (Cabal Flags) ? arg "in-ghc-tree"
- ---------------------------- ghc-boot-th-next --------------------------
- , package ghcBootThNext ?
- builder (Cabal Flags) ? stage0 `cabalFlag` "bootstrap"
-
---------------------------------- text --------------------------------
, package text ? mconcat
-- Disable SIMDUTF by default due to packaging difficulties
=====================================
libraries/base/src/Data/Array/Byte.hs
=====================================
@@ -183,6 +183,7 @@ instance Show ByteArray where
where
comma | i == 0 = id
| otherwise = showString ", "
+
instance Lift ByteArray where
liftTyped x = unsafeCodeCoerce (lift x)
lift (ByteArray b) = return
=====================================
libraries/ghc-boot-th/GHC/Internal/TH/Lift.hs deleted
=====================================
@@ -1,3 +0,0 @@
--- |
-
-module GHC.Internal.TH.Lift where
=====================================
libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs
=====================================
@@ -8,7 +8,7 @@
--
-- A data type defining the language extensions supported by GHC.
--
-{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE Safe #-}
module GHC.LanguageExtensions.Type ( Extension(..) ) where
import GHC.Internal.LanguageExtensions
=====================================
libraries/ghc-boot-th/ghc-boot-th.cabal.in
=====================================
@@ -29,8 +29,8 @@ source-repository head
Flag bootstrap
Description:
Enabled when building the stage1 compiler in order to vendor the in-tree
- `template-haskell` library (including its dependency `ghc-boot-th`), while
- allowing dependencies to depend on the boot `template-haskell` library.
+ `ghc-boot-th` library (dependency of `template-haskell`), while allowing
+ dependencies to depend on the boot `template-haskell` library.
See Note [Bootstrapping Template Haskell]
Default: False
Manual: True
=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -35,15 +35,6 @@ source-repository head
location: https://gitlab.haskell.org/ghc/ghc.git
subdir: libraries/ghc-boot
-Flag bootstrap
- Description:
- Enabled when building the stage1 compiler in order to vendor the in-tree
- `template-haskell` library (including its dependency `ghc-boot-th`), while
- allowing dependencies to depend on the boot `template-haskell` library.
- See Note [Bootstrapping Template Haskell]
- Default: False
- Manual: True
-
Library
default-language: Haskell2010
other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables
@@ -83,6 +74,7 @@ Library
filepath >= 1.3 && < 1.6,
deepseq >= 1.4 && < 1.6,
ghc-platform >= 0.1,
+ ghc-boot-th == @ProjectVersionMunged@
-- reexport modules from ghc-boot-th so that packages
-- don't have to import all of ghc-boot and ghc-boot-th.
@@ -92,13 +84,6 @@ Library
, GHC.ForeignSrcLang.Type
, GHC.Lexeme
- if flag(bootstrap)
- build-depends:
- ghc-boot-th-next == @ProjectVersionMunged@
- else
- build-depends:
- ghc-boot-th == @ProjectVersionMunged@
-
if !os(windows)
build-depends:
unix >= 2.7 && < 2.9
=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -416,12 +416,15 @@ W3:
* Do-notation introduces references to GHC.Internal.Base for Monad stuff.
* Likewise arrow-notation to GHC.Internal.Control.Arrow
* Likewise RecursiveDo stuff to GHC.Internal.Control.Monad.Fix
- * (Does TemplateHaskellQuotes fall into this category as well?)
+ * TemplateHaskell quotes introduce references to GHC.Internal.TH.Lib.
- These are not problematic in practice. For example, a program
- that uses arrow-notation but does not otherwise import the Arrow
- type class will almost certainly fail to type-check anyway.
- (The "Arrow m" constraint will be very hard to solve!)
+ These are not problematic in practice, because we do not make use of
+ overloaded notation during bootstrap of GHC. Yet! If in the future we
+ we decide to use TemplateHaskell in GHC or `ghc-internal`, we need to
+ add explicit imports. To demonstrate that these errors can occur, consider
+ e n = [| True |]
+ which compiles with -XTemplateHaskell *without* requiring the user to
+ import GHC.Internal.TH.Lib.
W4:
Stock derived instances introduce references to various things.
@@ -430,15 +433,12 @@ W4:
as long as the module which defines Eq imports GHC.Magic this cannot
cause trouble.
- Things are a bit more complex for the Lift class (see #22229).
- * Derived Lift instances refer to machinery in
- Language.Haskell.TH.Lib.Internal, which is not imported by the module
- Language.Haskell.TH.Lib.Syntax that defines the Lift class.
- * Language.Haskell.TH.Lib.Internal imports Language.Haskell.TH.Lib.Syntax, so
- we can't add the reverse dependency without using a .hs-boot file
- * What we do instead is that we expose a module Language.Haskell.TH.Syntax
- importing both Language.Haskell.TH.Lib.{Syntax,Internal). Users are expected
- to import this module.
+ A similar solution concerns the deriving of Lift instances with
+ -XTemplateHaskell: A derived Lift instance must (transitively)
+ import GHC.Internal.TH.Lift, where the Lift class is defined.
+ The derived Lift instance references various identifiers in
+ GHC.Internal.TH.Lib, so it is an import of GHC.Internal.TH.Lift.
+
W5:
If no explicit "default" declaration is present, the assumed
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -39,6 +39,7 @@ module GHC.Internal.TH.Lift
where
import GHC.Internal.TH.Syntax
+import GHC.Internal.TH.Lib () -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
import GHC.Internal.Lexeme ( startsVarSym, startsVarId )
import GHC.Internal.Data.Either
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
=====================================
@@ -17,15 +17,10 @@ This is an internal module. Please import 'Language.Haskell.TH.Quote' instead.
-}
module GHC.Internal.TH.Quote(
QuasiQuoter(..),
- quoteFile,
- -- * For backwards compatibility
- dataToQa, dataToExpQ, dataToPatQ
) where
import GHC.Internal.TH.Syntax
-import GHC.Internal.TH.Lift
import GHC.Internal.Base hiding (Type)
-import GHC.Internal.System.IO
-- | The 'QuasiQuoter' type, a value @q@ of this type can be used
@@ -45,18 +40,3 @@ data QuasiQuoter = QuasiQuoter {
-- | Quasi-quoter for declarations, invoked by top-level quotes
quoteDec :: String -> Q [Dec]
}
-
--- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
--- the data out of a file. For example, suppose @asmq@ is an
--- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
--- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
--- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
--- of the inline text
-quoteFile :: QuasiQuoter -> QuasiQuoter
-quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd })
- = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }
- where
- get :: (String -> Q a) -> String -> Q a
- get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
- ; addDependentFile file_name
- ; old_quoter file_cts }
=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -22,15 +22,6 @@ Flag internal-interpreter
Default: False
Manual: True
-Flag bootstrap
- Description:
- Enabled when building the stage1 compiler in order to vendor the in-tree
- `template-haskell` library (including its dependency `ghc-boot-th`), while
- allowing dependencies to depend on the boot `template-haskell` library.
- See Note [Bootstrapping Template Haskell]
- Default: False
- Manual: True
-
source-repository head
type: git
location: https://gitlab.haskell.org/ghc/ghc.git
@@ -92,15 +83,9 @@ library
deepseq >= 1.4 && < 1.6,
filepath >= 1.4 && < 1.6,
ghc-boot == @ProjectVersionMunged@,
+ ghc-boot-th == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,
transformers >= 0.5 && < 0.7
- if flag(bootstrap)
- build-depends:
- ghc-boot-th-next == @ProjectVersionMunged@
- else
- build-depends:
- ghc-boot-th == @ProjectVersionMunged@
-
if !os(windows)
Build-Depends: unix >= 2.7 && < 2.9
=====================================
libraries/template-haskell/Language/Haskell/TH/Quote.hs
=====================================
@@ -14,7 +14,28 @@ 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
+ ( QuasiQuoter(..)
+ , quoteFile
+ -- * For backwards compatibility
+ ,dataToQa, dataToExpQ, dataToPatQ
+ ) where
+import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Quote
+import GHC.Internal.TH.Lift
+
+
+-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
+-- the data out of a file. For example, suppose @asmq@ is an
+-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
+-- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
+-- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
+-- of the inline text
+quoteFile :: QuasiQuoter -> QuasiQuoter
+quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd })
+ = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }
+ where
+ get :: (String -> Q a) -> String -> Q a
+ get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
+ ; addDependentFile file_name
+ ; old_quoter file_cts }
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -9,20 +9,8 @@ import GHC.Internal.TH.Syntax
import GHC.Internal.TH.Lift
import System.FilePath
--- 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 Lift fixes this.
---
--- See Note [Tracking dependencies on primitives] in GHC.Internal.Base, wrinkle W4.
-import GHC.Internal.TH.Lib ()
-
+-- This module completely re-exports 'GHC.Internal.TH.Syntax',
+-- and exports additionally functions that depend on filepath.
-- | The input is a filepath, which if relative is offset by the package root.
makeRelativeToProject :: FilePath -> Q FilePath
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061d7c18e0506f350bd03393c012b79968b2814d...0feca2967aaecf2f11736d8a173ff5cb68a0f44f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/061d7c18e0506f350bd03393c012b79968b2814d...0feca2967aaecf2f11736d8a173ff5cb68a0f44f
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/20240509/c9313934/attachment-0001.html>
More information about the ghc-commits
mailing list