Teo Camarasu pushed to branch wip/T25262 at Glasgow Haskell Compiler / GHC
Commits:
-
25d686d9
by Teo Camarasu at 2025-10-09T14:39:37+01:00
7 changed files:
- .gitmodules
- hadrian/src/Packages.hs
- hadrian/src/Settings/Default.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs
- + libraries/template-haskell-lift
- + libraries/template-haskell-quasiquoter
Changes:
... | ... | @@ -118,3 +118,9 @@ |
118 | 118 | [submodule "libraries/file-io"]
|
119 | 119 | path = libraries/file-io
|
120 | 120 | url = https://gitlab.haskell.org/ghc/packages/file-io.git
|
121 | +[submodule "libraries/template-haskell-lift"]
|
|
122 | + path = libraries/template-haskell-lift
|
|
123 | + url = https://gitlab.haskell.org/ghc/template-haskell-lift.git
|
|
124 | +[submodule "libraries/template-haskell-quasiquoter"]
|
|
125 | + path = libraries/template-haskell-quasiquoter
|
|
126 | + url = https://gitlab.haskell.org/ghc/template-haskell-quasiquoter.git |
... | ... | @@ -9,7 +9,7 @@ module Packages ( |
9 | 9 | ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline,
|
10 | 10 | hsc2hs, hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy,
|
11 | 11 | libffi, mtl, osString, parsec, pretty, primitive, process, remoteIserv, rts,
|
12 | - runGhc, semaphoreCompat, stm, templateHaskell, terminfo, text, time, timeout,
|
|
12 | + runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter, terminfo, text, time, timeout,
|
|
13 | 13 | transformers, unlit, unix, win32, xhtml,
|
14 | 14 | lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace,
|
15 | 15 | ghcPackages, isGhcPackage,
|
... | ... | @@ -39,7 +39,7 @@ ghcPackages = |
39 | 39 | , ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghcInternal, ghci, ghciWrapper, ghcPkg, ghcPrim
|
40 | 40 | , ghcToolchain, ghcToolchainBin, haddockApi, haddockLibrary, haddock, haskeline, hsc2hs
|
41 | 41 | , hp2ps, hpc, hpcBin, integerGmp, iserv, libffi, mtl, osString
|
42 | - , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell
|
|
42 | + , parsec, pretty, process, rts, runGhc, stm, semaphoreCompat, templateHaskell, thLift, thQuasiquoter
|
|
43 | 43 | , terminfo, text, time, transformers, unlit, unix, win32, xhtml, fileio
|
44 | 44 | , timeout
|
45 | 45 | , lintersCommon
|
... | ... | @@ -56,7 +56,7 @@ array, base, binary, bytestring, cabalSyntax, cabal, checkPpr, checkExact, count |
56 | 56 | ghcCompact, ghcConfig, ghcExperimental, ghcHeap, ghci, ghcInternal, ghciWrapper, ghcPkg, ghcPrim,
|
57 | 57 | ghcToolchain, ghcToolchainBin, haddockLibrary, haddockApi, haddock, haskeline, hsc2hs,
|
58 | 58 | hp2ps, hpc, hpcBin, integerGmp, iserv, iservProxy, remoteIserv, libffi, mtl,
|
59 | - osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell,
|
|
59 | + osString, parsec, pretty, primitive, process, rts, runGhc, semaphoreCompat, stm, templateHaskell, thLift, thQuasiquoter,
|
|
60 | 60 | terminfo, text, time, transformers, unlit, unix, win32, xhtml,
|
61 | 61 | timeout,
|
62 | 62 | lintersCommon, lintNotes, lintCodes, lintCommitMsg, lintSubmoduleRefs, lintWhitespace
|
... | ... | @@ -124,6 +124,8 @@ runGhc = util "runghc" |
124 | 124 | semaphoreCompat = lib "semaphore-compat"
|
125 | 125 | stm = lib "stm"
|
126 | 126 | templateHaskell = lib "template-haskell"
|
127 | +thLift = lib "template-haskell-lift"
|
|
128 | +thQuasiquoter = lib "template-haskell-quasiquoter"
|
|
127 | 129 | terminfo = lib "terminfo"
|
128 | 130 | text = lib "text"
|
129 | 131 | time = lib "time"
|
... | ... | @@ -107,6 +107,8 @@ stage0Packages = do |
107 | 107 | , runGhc
|
108 | 108 | , semaphoreCompat -- depends on
|
109 | 109 | , time -- depends on win32
|
110 | + , thLift -- new library not yet present for boot compilers
|
|
111 | + , thQuasiquoter -- new library not yet present for boot compilers
|
|
110 | 112 | , unlit
|
111 | 113 | , if windowsHost then win32 else unix
|
112 | 114 | -- We must use the in-tree `Win32` as the version
|
... | ... | @@ -20,7 +20,7 @@ |
20 | 20 | -- | This module gives the definition of the 'Lift' class.
|
21 | 21 | --
|
22 | 22 | -- This is an internal module.
|
23 | --- Please import "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
|
|
23 | +-- Please import "Language.Haskell.TH.Lift", "Language.Haskell.TH" or "Language.Haskell.TH.Syntax" instead!
|
|
24 | 24 | |
25 | 25 | module GHC.Internal.TH.Lift
|
26 | 26 | ( Lift(..)
|
... | ... | @@ -71,6 +71,9 @@ import GHC.Internal.ForeignPtr |
71 | 71 | -- > deriving Lift
|
72 | 72 | --
|
73 | 73 | -- Representation-polymorphic since /template-haskell-2.16.0.0/.
|
74 | +--
|
|
75 | +-- This is exposed both from the @template-haskell-lift@ and @template-haskell@ packages.
|
|
76 | +-- Consider importing it from the more stable @template-haskell-lift@ if you don't need the full breadth of the @template-haskell@ interface.
|
|
74 | 77 | class Lift (t :: TYPE r) where
|
75 | 78 | -- | Turn a value into a Template Haskell expression, suitable for use in
|
76 | 79 | -- a splice.
|
... | ... | @@ -31,6 +31,9 @@ import GHC.Internal.Base hiding (Type) |
31 | 31 | -- @QuasiQuoter@ that is only intended to be used in certain splice
|
32 | 32 | -- contexts, the unused fields should just 'fail'. This is most easily
|
33 | 33 | -- accomplished using 'namedefaultQuasiQuoter' or 'defaultQuasiQuoter'.
|
34 | +--
|
|
35 | +-- This is exposed both from the @template-haskell-quasiquoter@ and @template-haskell@ packages.
|
|
36 | +-- Consider importing it from the more stable @template-haskell-quasiquoter@ if you don't need the full breadth of the @template-haskell@ interface.
|
|
34 | 37 | data QuasiQuoter = QuasiQuoter {
|
35 | 38 | -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@
|
36 | 39 | quoteExp :: String -> Q Exp,
|
1 | +Subproject commit e0b2a7eefcd1b7247af63ab4a691d3161eada284 |
1 | +Subproject commit d81f6174d0a3e397cde118710191925aee297eb6 |