[Git][ghc/ghc][wip/T23536-teo] 2 commits: Revert "Use TemplateHaskellQuotes in TH.Syntax to construct Names"

Teo Camarasu (@teo) gitlab at gitlab.haskell.org
Wed Apr 3 14:39:54 UTC 2024



Teo Camarasu pushed to branch wip/T23536-teo at Glasgow Haskell Compiler / GHC


Commits:
2a1c7a73 by Teo Camarasu at 2024-04-03T14:00:32+01:00
Revert "Use TemplateHaskellQuotes in TH.Syntax to construct Names"

This reverts commit 983ce55815f2dd57f84ee86eee97febf7d80b470.

- - - - -
85e4fe45 by Teo Camarasu at 2024-04-03T15:25:07+01:00
Make template-haskell a stage1 package

Promoting template-haskell from a stage0 to a stage1 package means that
we can much more easily refactor template-haskell.

In order to accomplish this we now  compile stage0 packages using
the boot compiler's version of template-haskell.

This means that there are now two versions of template-haskell in play:
the boot compiler's version, and the in-tree version.
When compiling the stage1 compiler, we have to pick a version of
template-haskell to use.

During bootstrapping we want to use the same version as the final
compiler. This forces the in-tree version. We are only able to use the
internal interpreter with stage2 onwards. Yet, we could still use the
external interpreter.

The external interpreter runs splices in another process. Queries and
results are seralised. This reduces our compatibility requirements from
ABI compatibility with the internal interpreter to mere serialisation
compatibility. We may compile GHC against another library to what the
external interpreter is compiled against so long as it has exactly the
same serialisation of template-haskell types.

This opens up the strategy pursued in this patch.

We introduce two new packages: template-haskell-in-tree and
ghc-boot-th-in-tree. These package are carbon copies of template-haskell
and ghc-boot-th respectively. They only differ in their name.

When compiling the stage1 compiler we use these to define the Template
Haskell interface for the external interpreter. Note that at this point
we also have the template-haskell and ghc-boot packages in our
transitive dependency closure from the boot compiler, and some packages
like containers have dependencies on these to define Lift instances.

Then the external interpreter should be compiled against the regular
template-haskell library from the source tree. As these two packages are
identical, we can then run splices.

GHC stage2 is compiled as normal as well against the template-haskell
library from the source tree.

Resolves #23536

- - - - -


13 changed files:

- compiler/ghc.cabal.in
- hadrian/src/Packages.hs
- hadrian/src/Rules/Dependencies.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal
- + libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghci/ghci.cabal.in
- + libraries/template-haskell-in-tree/template-haskell-in-tree.cabal
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs


Changes:

=====================================
compiler/ghc.cabal.in
=====================================
@@ -82,6 +82,11 @@ Flag hadrian-stage0
     Default: False
     Manual: True
 
+Flag bootstrap-th
+    Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib
+    Default: False
+    Manual: True
+
 Library
     Default-Language: GHC2021
     Exposed: False
@@ -115,7 +120,6 @@ Library
                    containers >= 0.6.2.1 && < 0.8,
                    array      >= 0.1 && < 0.6,
                    filepath   >= 1   && < 1.6,
-                   template-haskell == 2.22.*,
                    hpc        >= 0.6 && < 0.8,
                    transformers >= 0.5 && < 0.7,
                    exceptions == 0.10.*,
@@ -125,6 +129,13 @@ Library
                    ghc-heap   == @ProjectVersionMunged@,
                    ghci == @ProjectVersionMunged@
 
+    if flag(bootstrap-th)
+      Build-Depends:
+                   template-haskell-in-tree == 2.22.*
+    else
+      Build-Depends:
+                   template-haskell         == 2.22.*
+
     if os(windows)
         Build-Depends: Win32  >= 2.3 && < 2.15
     else


=====================================
hadrian/src/Packages.hs
=====================================
@@ -4,12 +4,12 @@ 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, ghcPlatform,
+    exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform,
     ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim,
     ghcToolchain, ghcToolchainBin, haddock, haskeline,
     hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, iservProxy,
     libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts,
-    runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout,
+    runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree, terminfo, text, time, timeout,
     transformers, unlit, unix, win32, xhtml,
     lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
     ghcPackages, isGhcPackage,
@@ -37,11 +37,11 @@ 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, ghcPlatform
+    , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, ghcPlatform
     , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim
     , ghcToolchain, ghcToolchainBin, haddock, haskeline, hsc2hs
     , hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, mtl, osString
-    , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
+    , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, templateHaskellInTree
     , terminfo, text, time, transformers, unlit, unix, win32, xhtml
     , timeout
     , lintersCommon
@@ -54,11 +54,11 @@ 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, ghcPlatform,
+  exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcBootThInTree, 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,
-  osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
+  osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, templateHaskellInTree,
   terminfo, text, time, transformers, unlit, unix, win32, xhtml,
   timeout,
   lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
@@ -87,6 +87,7 @@ ghc                 = prg  "ghc-bin"         `setPath` "ghc"
 ghcBignum           = lib  "ghc-bignum"
 ghcBoot             = lib  "ghc-boot"
 ghcBootTh           = lib  "ghc-boot-th"
+ghcBootThInTree     = lib  "ghc-boot-th-in-tree"
 ghcPlatform         = lib  "ghc-platform"
 ghcCompact          = lib  "ghc-compact"
 ghcConfig           = prg  "ghc-config"      `setPath` "testsuite/ghc-config"
@@ -123,6 +124,7 @@ runGhc              = util "runghc"
 semaphoreCompat     = lib  "semaphore-compat"
 stm                 = lib  "stm"
 templateHaskell     = lib  "template-haskell"
+templateHaskellInTree = lib  "template-haskell-in-tree"
 terminfo            = lib  "terminfo"
 text                = lib  "text"
 time                = lib  "time"


=====================================
hadrian/src/Rules/Dependencies.hs
=====================================
@@ -35,7 +35,10 @@ extra_dependencies =
 
   where
     th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
-    dep (p1, m1) (p2, m2) s = do
+    dep (p1, m1) (p2, m2) s =
+      -- We use the boot compiler's `template-haskell` library when building stage0,
+      -- so we don't need to register dependencies.
+      if isStage0 s then pure [] else do
         let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set")
         ways <- interpretInContext context getLibraryWays
         mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways)


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -23,10 +23,12 @@ import Rules.Libffi
 import Settings
 import Target
 import Utilities
+import Debug.Trace
 
 import GHC.Toolchain as Toolchain hiding (HsCpp(HsCpp))
 import GHC.Toolchain.Program
 import GHC.Platform.ArchOS
+import qualified System.Directory as IO
 
 -- | Track this file to rebuild generated files whenever it changes.
 trackGenerateHs :: Expr ()
@@ -119,6 +121,7 @@ generatePackageCode context@(Context stage pkg _ _) = do
     let dir         = buildDir context
         generated f = (root -/- dir -/- "**/*.hs") ?== f && not ("//autogen/*" ?== f)
         go gen file = generate file context gen
+
     generated ?> \file -> do
         let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
         (src, builder) <- unpack <$> findGenerator context file
@@ -143,6 +146,22 @@ generatePackageCode context@(Context stage pkg _ _) = do
         when (pkg == ghcBoot) $ do
             root -/- "**" -/- dir -/- "GHC/Version.hs" %> go generateVersionHs
             root -/- "**" -/- dir -/- "GHC/Platform/Host.hs" %> go generatePlatformHostHs
+        when (pkg == ghcBootThInTree) $ do
+            let prefix = root -/- dir
+            prefix -/- "**/*.hs" %> \file -> do
+              cwd <- liftIO $ IO.getCurrentDirectory
+              createFileLink (cwd -/- "libraries/ghc-boot-th" -/- makeRelative prefix file) file
+        when (pkg == templateHaskellInTree) $ do
+            let prefix = root -/- dir
+            prefix -/- "**/*.hs" %> \file -> do
+              cwd <- liftIO $ IO.getCurrentDirectory
+              let rel = makeRelative prefix file
+              let rootCandidate = cwd -/- "libraries/template-haskell" -/- rel
+              let vendoredCandidate = cwd -/- "libraries/template-haskell" -/- "vendored-filepath" -/- rel
+              exists <- liftIO $ IO.doesFileExist rootCandidate
+              if exists
+                then createFileLink rootCandidate file
+                else createFileLink vendoredCandidate file
 
     when (pkg == compiler) $ do
         root -/- primopsTxt stage %> \file -> do
@@ -325,6 +344,7 @@ templateRules = do
   templateRule "utils/runghc/runghc.cabal" $ projectVersion
   templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion
   templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion
+  templateRule "libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal" $ projectVersion
   templateRule "libraries/ghci/ghci.cabal" $ projectVersion
   templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion
   templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion
@@ -348,7 +368,6 @@ templateRules = do
     , interpolateVar "LlvmMaxVersion" $ replaceEq '.' ',' <$> setting LlvmMaxVersion
     ]
 
-
 -- Generators
 
 -- | GHC wrapper scripts used for passing the path to the right package database


=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -158,7 +158,7 @@ toolTargets = [ binary
               -- , ghc     -- # depends on ghc library
               -- , runGhc  -- # depends on ghc library
               , ghcBoot
-              , ghcBootTh
+              , ghcBootThInTree
               , ghcPlatform
               , ghcToolchain
               , ghcToolchainBin
@@ -172,8 +172,8 @@ toolTargets = [ binary
               , mtl
               , parsec
               , time
-              , templateHaskell
               , text
+              , templateHaskellInTree
               , transformers
               , semaphoreCompat
               , unlit  -- # executable


=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -93,7 +93,7 @@ stage0Packages = do
              , ghc
              , runGhc
              , ghcBoot
-             , ghcBootTh
+             , ghcBootThInTree
              , ghcPlatform
              , ghcHeap
              , ghcToolchain
@@ -108,8 +108,8 @@ stage0Packages = do
              , parsec
              , semaphoreCompat
              , time
-             , templateHaskell
              , text
+             , templateHaskellInTree
              , transformers
              , unlit
              , hp2ps
@@ -127,6 +127,10 @@ stage1Packages = do
           -- but not win32/unix because it depends on cross-compilation target
           | p == win32        = False
           | p == unix         = False
+          -- we don't keep ghc-boot-in-tree and template-haskell-in-tree
+          -- as they are only needed for bootstrapping Template Haskell
+          | p == ghcBootThInTree = False
+          | p == templateHaskellInTree = False
           | otherwise         = True
 
     libraries0 <- filter good_stage0_package <$> stage0Packages
@@ -143,6 +147,7 @@ stage1Packages = do
         , deepseq
         , exceptions
         , ghc
+        , ghcBootTh
         , ghcBignum
         , ghcCompact
         , ghcExperimental
@@ -156,6 +161,7 @@ stage1Packages = do
         , pretty
         , rts
         , semaphoreCompat
+        , templateHaskell
         , stm
         , unlit
         , xhtml


=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -78,6 +78,7 @@ packageArgs = do
 
           , builder (Cabal Flags) ? mconcat
             [ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
+            , stage0 `cabalFlag` "bootstrap-th"
             , notM cross `cabalFlag` "terminfo"
             , arg "-build-tool-depends"
             , flag UseLibzstd `cabalFlag` "with-libzstd"
@@ -121,6 +122,10 @@ packageArgs = do
           , builder (Cc CompileC) ? (not <$> flag CcLlvmBackend) ?
             input "**/cbits/atomic.c"  ? arg "-Wno-sync-nand" ]
 
+        -------------------------------- ghcBoot ------------------------------
+        , package ghcBoot ?
+            builder (Cabal Flags) ? (stage0 `cabalFlag` "bootstrap-th")
+
         --------------------------------- ghci ---------------------------------
         , package ghci ? mconcat
           [
@@ -151,9 +156,12 @@ packageArgs = do
           -- compiler comes with the same versions as the one we are building.
           --
             builder (Cabal Setup) ? cabalExtraDirs ffiIncludeDir ffiLibraryDir
-          , builder (Cabal Flags) ? ifM stage0
-              (andM [cross, bootCross] `cabalFlag` "internal-interpreter")
-              (arg "internal-interpreter")
+          , builder (Cabal Flags) ? mconcat [
+              ifM stage0
+                (andM [cross, bootCross] `cabalFlag` "internal-interpreter")
+                (arg "internal-interpreter")
+              , stage0 `cabalFlag` "bootstrap-th"
+              ]
 
           ]
 


=====================================
libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal
=====================================
@@ -0,0 +1,39 @@
+-- WARNING: ghc-boot-th.cabal is automatically generated from
+-- ghc-boot-th.cabal.in by ../../configure.  Make sure you are editing
+-- ghc-boot-th.cabal.in, not ghc-boot-th.cabal.
+
+name:           ghc-boot-th-in-tree
+version:        9.11
+license:        BSD3
+license-file:   LICENSE
+category:       GHC
+maintainer:     ghc-devs at haskell.org
+bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues/new
+synopsis:       Shared functionality between GHC and the @template-haskell@
+                library
+description:    This library contains various bits shared between the @ghc@ and
+                @template-haskell@ libraries.
+                .
+                This package exists to ensure that @template-haskell@ has a
+                minimal set of transitive dependencies, since it is intended to
+                be depended upon by user code.
+cabal-version:  >=1.10
+build-type:     Simple
+extra-source-files: changelog.md
+
+source-repository head
+    type:     git
+    location: https://gitlab.haskell.org/ghc/ghc.git
+    subdir:   libraries/ghc-boot-th
+
+Library
+    default-language: Haskell2010
+    other-extensions: DeriveGeneric
+    default-extensions: NoImplicitPrelude
+
+    exposed-modules:
+            GHC.LanguageExtensions.Type
+            GHC.ForeignSrcLang.Type
+            GHC.Lexeme
+
+    build-depends: base       >= 4.7 && < 4.21


=====================================
libraries/ghc-boot-th-in-tree/ghc-boot-th-in-tree.cabal.in
=====================================
@@ -0,0 +1,39 @@
+-- WARNING: ghc-boot-th.cabal is automatically generated from
+-- ghc-boot-th.cabal.in by ../../configure.  Make sure you are editing
+-- ghc-boot-th.cabal.in, not ghc-boot-th.cabal.
+
+name:           ghc-boot-th-in-tree
+version:        @ProjectVersionMunged@
+license:        BSD3
+license-file:   LICENSE
+category:       GHC
+maintainer:     ghc-devs at haskell.org
+bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues/new
+synopsis:       Shared functionality between GHC and the @template-haskell@
+                library
+description:    This library contains various bits shared between the @ghc@ and
+                @template-haskell@ libraries.
+                .
+                This package exists to ensure that @template-haskell@ has a
+                minimal set of transitive dependencies, since it is intended to
+                be depended upon by user code.
+cabal-version:  >=1.10
+build-type:     Simple
+extra-source-files: changelog.md
+
+source-repository head
+    type:     git
+    location: https://gitlab.haskell.org/ghc/ghc.git
+    subdir:   libraries/ghc-boot-th
+
+Library
+    default-language: Haskell2010
+    other-extensions: DeriveGeneric
+    default-extensions: NoImplicitPrelude
+
+    exposed-modules:
+            GHC.LanguageExtensions.Type
+            GHC.ForeignSrcLang.Type
+            GHC.Lexeme
+
+    build-depends: base       >= 4.7 && < 4.21


=====================================
libraries/ghc-boot/ghc-boot.cabal.in
=====================================
@@ -35,6 +35,11 @@ source-repository head
     location: https://gitlab.haskell.org/ghc/ghc.git
     subdir:   libraries/ghc-boot
 
+Flag bootstrap-th
+        Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib
+        Default: False
+        Manual: True
+
 Library
     default-language: Haskell2010
     other-extensions: DeriveGeneric, RankNTypes, ScopedTypeVariables
@@ -81,7 +86,12 @@ Library
                    filepath   >= 1.3 && < 1.6,
                    deepseq    >= 1.4 && < 1.6,
                    ghc-platform >= 0.1,
-                   ghc-boot-th == @ProjectVersionMunged@
+    if flag(bootstrap-th)
+      build-depends:
+                   ghc-boot-th-in-tree == @ProjectVersionMunged@
+    else
+      build-depends:
+                   ghc-boot-th         == @ProjectVersionMunged@
     if !os(windows)
         build-depends:
                    unix       >= 2.7 && < 2.9


=====================================
libraries/ghci/ghci.cabal.in
=====================================
@@ -22,6 +22,11 @@ Flag internal-interpreter
     Default: False
     Manual: True
 
+Flag bootstrap-th
+    Description: Enable if we are bootstrapping template-haskell, and hence want to depend on both the in-tree and boot `template-haskell` lib
+    Default: False
+    Manual: True
+
 source-repository head
     type:     git
     location: https://gitlab.haskell.org/ghc/ghc.git
@@ -84,8 +89,14 @@ library
         filepath         >= 1.4 && < 1.6,
         ghc-boot         == @ProjectVersionMunged@,
         ghc-heap         == @ProjectVersionMunged@,
-        template-haskell == 2.22.*,
         transformers     >= 0.5 && < 0.7
 
+    if flag(bootstrap-th)
+      Build-Depends:
+        template-haskell-in-tree == 2.22.*
+    else
+      Build-Depends:
+        template-haskell         == 2.22.*
+
     if !os(windows)
         Build-Depends: unix >= 2.7 && < 2.9


=====================================
libraries/template-haskell-in-tree/template-haskell-in-tree.cabal
=====================================
@@ -0,0 +1,71 @@
+-- WARNING: template-haskell.cabal is automatically generated from template-haskell.cabal.in by
+-- ../../configure.  Make sure you are editing template-haskell.cabal.in, not
+-- template-haskell.cabal.
+
+name:           template-haskell-in-tree
+version:        2.22.0.0
+-- NOTE: Don't forget to update ./changelog.md
+license:        BSD3
+license-file:   LICENSE
+category:       Template Haskell
+maintainer:     libraries at haskell.org
+bug-reports:    https://gitlab.haskell.org/ghc/ghc/issues/new
+synopsis:       Support library for Template Haskell
+build-type:     Simple
+Cabal-Version:  >= 1.10
+description:
+    This package provides modules containing facilities for manipulating
+    Haskell source code using Template Haskell.
+    .
+    See <http://www.haskell.org/haskellwiki/Template_Haskell> for more
+    information.
+
+extra-source-files: changelog.md
+
+source-repository head
+    type:     git
+    location: https://gitlab.haskell.org/ghc/ghc.git
+    subdir:   libraries/template-haskell-in-tree
+
+Library
+    default-language: Haskell2010
+    other-extensions:
+        BangPatterns
+        CPP
+        DefaultSignatures
+        DeriveDataTypeable
+        DeriveGeneric
+        FlexibleInstances
+        RankNTypes
+        RoleAnnotations
+        ScopedTypeVariables
+
+    exposed-modules:
+        Language.Haskell.TH
+        Language.Haskell.TH.Lib
+        Language.Haskell.TH.Ppr
+        Language.Haskell.TH.PprLib
+        Language.Haskell.TH.Quote
+        Language.Haskell.TH.Syntax
+        Language.Haskell.TH.LanguageExtensions
+        Language.Haskell.TH.CodeDo
+        Language.Haskell.TH.Lib.Internal
+
+    other-modules:
+        Language.Haskell.TH.Lib.Map
+
+    build-depends:
+        base        >= 4.11 && < 4.21,
+        ghc-boot-th-in-tree == 9.11,
+        ghc-prim,
+        pretty      == 1.1.*
+
+    other-modules:
+      System.FilePath
+      System.FilePath.Posix
+      System.FilePath.Windows
+    hs-source-dirs: ./vendored-filepath .
+    default-extensions:
+      ImplicitPrelude
+
+    ghc-options: -Wall


=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -7,7 +7,6 @@
              BangPatterns, RecordWildCards, ImplicitParams #-}
 
 {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
-{-# LANGUAGE TemplateHaskellQuotes #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 
 -----------------------------------------------------------------------------
@@ -69,6 +68,7 @@ import Prelude hiding (Applicative(..))
 import Foreign.ForeignPtr
 import Foreign.C.String
 import Foreign.C.Types
+import GHC.Stack
 
 import Data.Array.Byte (ByteArray(..))
 import GHC.Exts
@@ -1083,7 +1083,8 @@ instance Lift (Fixed.Fixed a) where
     ex <- lift x
     return (ConE mkFixedName `AppE` ex)
     where
-      mkFixedName = 'Fixed.MkFixed
+      mkFixedName =
+        mkNameG DataName "base" "Data.Fixed" "MkFixed"
 
 instance Integral a => Lift (Ratio a) where
   liftTyped x = unsafeCodeCoerce (lift x)
@@ -1152,8 +1153,19 @@ instance Lift ByteArray where
       ptr :: ForeignPtr Word8
       ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb))
 
+
+-- We can't use a TH quote in this module because we're in the template-haskell
+-- package, so we conconct this quite defensive solution to make the correct name
+-- which will work if the package name or module name changes in future.
 addrToByteArrayName :: Name
-addrToByteArrayName = 'addrToByteArray
+addrToByteArrayName = helper
+  where
+    helper :: HasCallStack => Name
+    helper =
+      case getCallStack ?callStack of
+        [] -> error "addrToByteArrayName: empty call stack"
+        (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"
+
 
 addrToByteArray :: Int -> Addr# -> ByteArray
 addrToByteArray (I# len) addr = runST $ ST $
@@ -1371,24 +1383,23 @@ instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
 
 
 trueName, falseName :: Name
-trueName  = 'True
-falseName = 'False
+trueName  = mkNameG DataName "ghc-prim" "GHC.Types" "True"
+falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"
 
 nothingName, justName :: Name
-nothingName = 'Nothing
-justName    = 'Just
+nothingName = mkNameG DataName "ghc-internal" "GHC.Internal.Maybe" "Nothing"
+justName    = mkNameG DataName "ghc-internal" "GHC.Internal.Maybe" "Just"
 
 leftName, rightName :: Name
-leftName  = 'Left
-rightName = 'Right
+leftName  = mkNameG DataName "ghc-internal" "GHC.Internal.Data.Either" "Left"
+rightName = mkNameG DataName "ghc-internal" "GHC.Internal.Data.Either" "Right"
 
 nonemptyName :: Name
-nonemptyName = '(:|)
+nonemptyName = mkNameG DataName "ghc-internal" "GHC.Internal.Base" ":|"
 
 oneName, manyName :: Name
-oneName  = 'One
-manyName = 'Many
-
+oneName  = mkNameG DataName "ghc-prim" "GHC.Types" "One"
+manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"
 -----------------------------------------------------
 --
 --              Generic Lift implementations



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9290c3e65208709854b1419e649228d37816194...85e4fe4520970b390b6cd6eacaf0e59d2d63f2b7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9290c3e65208709854b1419e649228d37816194...85e4fe4520970b390b6cd6eacaf0e59d2d63f2b7
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/20240403/7b311feb/attachment-0001.html>


More information about the ghc-commits mailing list