[Git][ghc/ghc][wip/T14030] Implement the "Derive Lift instances for data types in template-haskell" proposal (#14030)
Sebastian Graf (@sgraf812)
gitlab at gitlab.haskell.org
Fri Jun 14 11:48:27 UTC 2024
Sebastian Graf pushed to branch wip/T14030 at Glasgow Haskell Compiler / GHC
Commits:
90eb495b by Sebastian Graf at 2024-06-14T13:47:21+02:00
Implement the "Derive Lift instances for data types in template-haskell" proposal (#14030)
After #22229 had been fixed, we can finally derive the `Lift` instance for the
TH AST, as proposed by Ryan Scott in
https://mail.haskell.org/pipermail/libraries/2015-September/026117.html.
Fixes #14030, #14296, #21759 and #24560.
- - - - -
8 changed files:
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
- testsuite/tests/ghci/scripts/T21110.stderr
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- testsuite/tests/th/TH_Lift.hs
- + testsuite/tests/th/TH_Lift.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -42,7 +42,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 qualified GHC.Internal.TH.Lib as Lib (litE) -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
import GHC.Internal.Lexeme ( startsVarSym, startsVarId )
import GHC.Internal.Data.Either
@@ -54,8 +54,9 @@ import GHC.Internal.Integer
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Int
-import GHC.Internal.Data.Data
+import GHC.Internal.Data.Data hiding (Fixity)
import GHC.Internal.Natural
+import GHC.Internal.ForeignPtr
-- | 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
@@ -305,6 +306,140 @@ rightName = 'Right
nonemptyName :: Name
nonemptyName = '(:|)
+-----------------------------------------------------
+--
+-- Lifting the TH AST
+--
+-----------------------------------------------------
+
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Loc
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DocLoc
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift ModName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift GHC.Internal.TH.Syntax.Module
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NameSpace
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NamespaceSpecifier
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PkgName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NameFlavour
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift OccName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Name
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NameIs
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Specificity
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift BndrVis
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift a => Lift (TyVarBndr a)
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TyLit
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Type
+-- | @since template-haskell-2.22.1.0
+instance Lift Bytes where
+ lift bytes = -- See Note [Why FinalPtr]
+ [| Bytes
+ { bytesPtr = ForeignPtr $(Lib.litE (BytesPrimL bytes)) FinalPtr
+ , bytesOffset = 0
+ , bytesSize = $(lift (bytesSize bytes))
+ }
+ |]
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Lit
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Pat
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Clause
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DerivClause
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DerivStrategy
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Overlap
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FunDep
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Safety
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Callconv
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Foreign
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift ForeignSrcLang
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FixityDirection
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Fixity
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Inline
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift RuleMatch
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Phases
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift RuleBndr
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift AnnTarget
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Pragma
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift SourceStrictness
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift SourceUnpackedness
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DecidedStrictness
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Bang
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Con
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TySynEqn
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FamilyResultSig
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift InjectivityAnn
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TypeFamilyHead
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Role
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PatSynArgs
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PatSynDir
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Dec
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Range
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Exp
+-- | @since template-haskell-2.22.1.0
+instance Lift (TExp a) where
+ lift (TExp e) = [| TExp $(lift e) |]
+ liftTyped = unsafeCodeCoerce . lift
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Match
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Guard
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Stmt
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Body
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Info
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift AnnLookup
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Extension
+
-----------------------------------------------------
--
-- Generic Lift implementations
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -1,5 +1,9 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
+## 2.22.1.0
+
+ * `Lift` instances were added for the `template-haskell` AST.
+
## 2.22.0.0
* The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type`
=====================================
libraries/template-haskell/template-haskell.cabal.in
=====================================
@@ -3,7 +3,7 @@
-- template-haskell.cabal.
name: template-haskell
-version: 2.22.0.0
+version: 2.22.1.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD3
license-file: LICENSE
=====================================
testsuite/tests/ghci/scripts/T21110.stderr
=====================================
@@ -1,5 +1,5 @@
-
<no location info>: warning: [GHC-42258] [-Wunused-packages]
The following packages were specified via -package or -package-id flags,
but were not needed for compilation:
- - template-haskell-2.22.0.0 (exposed by flag -package template-haskell)
+ - template-haskell-2.22.1.0 (exposed by flag -package template-haskell)
+
=====================================
testsuite/tests/interface-stability/template-haskell-exports.stdout
=====================================
@@ -2420,11 +2420,37 @@ instance GHC.Internal.Show.Show GHC.Internal.LanguageExtensions.Extension -- Def
instance GHC.Internal.Show.Show GHC.Internal.TH.Ppr.ForallVisFlag -- Defined in ‘GHC.Internal.TH.Ppr’
instance [safe] GHC.Internal.Show.Show GHC.Internal.TH.PprLib.Doc -- Defined in ‘GHC.Internal.TH.PprLib’
instance GHC.Internal.Show.Show GHC.Internal.ForeignSrcLang.ForeignSrcLang -- Defined in ‘GHC.Internal.ForeignSrcLang’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.AnnLookup -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.AnnTarget -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Bang -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.BndrVis -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Body -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Bool -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Bytes -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Callconv -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Char -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Clause -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Con -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Dec -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.DecidedStrictness -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.DerivClause -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.DerivStrategy -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.DocLoc -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Double -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b) => GHC.Internal.TH.Lift.Lift (GHC.Internal.Data.Either.Either a b) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Exp -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.LanguageExtensions.Extension -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.FamilyResultSig -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Fixity -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.FixityDirection -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Float -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Foreign -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.ForeignSrcLang.ForeignSrcLang -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.FunDep -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Guard -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Info -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.InjectivityAnn -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Inline -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Int -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int16 -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int32 -- Defined in ‘GHC.Internal.TH.Lift’
@@ -2432,16 +2458,49 @@ instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int64 -- Defined in ‘GHC.I
instance GHC.Internal.TH.Lift.Lift GHC.Internal.Int.Int8 -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Num.Integer.Integer -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift [a] -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Lit -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Loc -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Match -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift (GHC.Internal.Maybe.Maybe a) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.ModName -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Module -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Name -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameFlavour -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameIs -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NameSpace -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.NamespaceSpecifier -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Num.Natural.Natural -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift (GHC.Internal.Base.NonEmpty a) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.OccName -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Overlap -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Pat -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.PatSynArgs -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.PatSynDir -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Phases -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.PkgName -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Pragma -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Range -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a. GHC.Internal.Real.Integral a => GHC.Internal.TH.Lift.Lift (GHC.Internal.Real.Ratio a) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Role -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.RuleBndr -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.RuleMatch -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Safety -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.SourceStrictness -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.SourceUnpackedness -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Specificity -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Stmt -- Defined in ‘GHC.Internal.TH.Lift’
+instance forall a. GHC.Internal.TH.Lift.Lift (GHC.Internal.TH.Syntax.TExp a) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b) => GHC.Internal.TH.Lift.Lift (a, b) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b c. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b, GHC.Internal.TH.Lift.Lift c) => GHC.Internal.TH.Lift.Lift (a, b, c) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b c d. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b, GHC.Internal.TH.Lift.Lift c, GHC.Internal.TH.Lift.Lift d) => GHC.Internal.TH.Lift.Lift (a, b, c, d) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b c d e. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b, GHC.Internal.TH.Lift.Lift c, GHC.Internal.TH.Lift.Lift d, GHC.Internal.TH.Lift.Lift e) => GHC.Internal.TH.Lift.Lift (a, b, c, d, e) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b c d e f. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b, GHC.Internal.TH.Lift.Lift c, GHC.Internal.TH.Lift.Lift d, GHC.Internal.TH.Lift.Lift e, GHC.Internal.TH.Lift.Lift f) => GHC.Internal.TH.Lift.Lift (a, b, c, d, e, f) -- Defined in ‘GHC.Internal.TH.Lift’
instance forall a b c d e f g. (GHC.Internal.TH.Lift.Lift a, GHC.Internal.TH.Lift.Lift b, GHC.Internal.TH.Lift.Lift c, GHC.Internal.TH.Lift.Lift d, GHC.Internal.TH.Lift.Lift e, GHC.Internal.TH.Lift.Lift f, GHC.Internal.TH.Lift.Lift g) => GHC.Internal.TH.Lift.Lift (a, b, c, d, e, f, g) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.TyLit -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.TySynEqn -- Defined in ‘GHC.Internal.TH.Lift’
+instance forall a. GHC.Internal.TH.Lift.Lift a => GHC.Internal.TH.Lift.Lift (GHC.Internal.TH.Syntax.TyVarBndr a) -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.Type -- Defined in ‘GHC.Internal.TH.Lift’
+instance GHC.Internal.TH.Lift.Lift GHC.Internal.TH.Syntax.TypeFamilyHead -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift () -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Internal.Base.Void -- Defined in ‘GHC.Internal.TH.Lift’
instance GHC.Internal.TH.Lift.Lift GHC.Types.Word -- Defined in ‘GHC.Internal.TH.Lift’
=====================================
testsuite/tests/th/TH_Lift.hs
=====================================
@@ -1,6 +1,7 @@
-- test Lifting instances
{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MagicHash #-}
module TH_Lift where
@@ -10,6 +11,8 @@ import Data.Word
import Data.Int
import Numeric.Natural
import Data.List.NonEmpty
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Internal as B
a :: Integer
a = $( (\x -> [| x |]) (5 :: Integer) )
@@ -80,3 +83,17 @@ o = $( (\x -> [| x |]) (True, 'x', 4 :: Int) )
p :: NonEmpty Char
p = $( (\x -> [| x |]) ('a' :| "bcde") )
+exp :: Exp
+exp = $( [| 3 + 4 |] >>= lift )
+
+texp :: TExp Int
+texp = $$( examineCode [|| 3 + 4 ||] `bindCode` liftTyped )
+
+bytes :: Bytes
+bytes = $(do
+ let (fp, offset, size) = B.toForeignPtr (B.pack [72, 101, 108, 108, 111]) -- "hello"#
+ let bytes = Bytes { bytesPtr = fp
+ , bytesOffset = fromIntegral offset
+ , bytesSize = fromIntegral size
+ }
+ lift bytes)
=====================================
testsuite/tests/th/TH_Lift.stderr
=====================================
@@ -0,0 +1,197 @@
+TH_Lift.hs:18:6-39: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Integer)
+ ======>
+ 5
+TH_Lift.hs:21:6-35: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Int)
+ ======>
+ 5
+TH_Lift.hs:24:7-37: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Int8)
+ ======>
+ 5
+TH_Lift.hs:27:7-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Int16)
+ ======>
+ 5
+TH_Lift.hs:30:7-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Int32)
+ ======>
+ 5
+TH_Lift.hs:33:7-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Int64)
+ ======>
+ 5
+TH_Lift.hs:36:6-36: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Word)
+ ======>
+ 5
+TH_Lift.hs:39:6-37: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Word8)
+ ======>
+ 5
+TH_Lift.hs:42:6-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Word16)
+ ======>
+ 5
+TH_Lift.hs:45:6-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Word32)
+ ======>
+ 5
+TH_Lift.hs:48:6-38: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Word64)
+ ======>
+ 5
+TH_Lift.hs:51:7-40: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 :: Natural)
+ ======>
+ 5
+TH_Lift.hs:54:6-44: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (5 % 3 :: Rational)
+ ======>
+ 1.6666666666666667
+TH_Lift.hs:57:7-39: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (pi :: Float)
+ ======>
+ 3.1415927410125732
+TH_Lift.hs:60:7-40: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (pi :: Double)
+ ======>
+ 3.141592653589793
+TH_Lift.hs:63:6-28: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ 'x'
+ ======>
+ 'x'
+TH_Lift.hs:66:6-29: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ True
+ ======>
+ True
+TH_Lift.hs:69:6-35: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (Just 'x')
+ ======>
+ Just 'x'
+TH_Lift.hs:72:6-58: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (Right False :: Either Char Bool)
+ ======>
+ Right False
+TH_Lift.hs:75:6-29: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ "hi!"
+ ======>
+ "hi!"
+TH_Lift.hs:78:6-27: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ ()
+ ======>
+ ()
+TH_Lift.hs:81:6-46: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ (True, 'x', 4 :: Int)
+ ======>
+ (,,) True 'x' 4
+TH_Lift.hs:84:6-41: Splicing expression
+ (\ x
+ -> [| x |]
+ pending(rn) [<x, lift x>])
+ ('a' :| "bcde")
+ ======>
+ (:|) 'a' "bcde"
+TH_Lift.hs:87:8-31: Splicing expression
+ [| 3 + 4 |] >>= lift
+ ======>
+ InfixE
+ (Just (LitE (IntegerL 3)))
+ (VarE
+ (Name
+ (OccName "+")
+ (NameG
+ VarName (PkgName "ghc-internal") (ModName "GHC.Internal.Num"))))
+ (Just (LitE (IntegerL 4)))
+TH_Lift.hs:(93,10)-(99,13): Splicing expression
+ do let (fp, offset, size)
+ = B.toForeignPtr (B.pack [72, 101, 108, 108, 111])
+ let bytes
+ = Bytes
+ {bytesPtr = fp, bytesOffset = fromIntegral offset,
+ bytesSize = fromIntegral size}
+ lift bytes
+ ======>
+ Bytes
+ {bytesPtr = GHC.Internal.ForeignPtr.ForeignPtr
+ "Hello"# GHC.Internal.ForeignPtr.FinalPtr,
+ bytesOffset = 0, bytesSize = 5}
+TH_Lift.hs:90:10-59: Splicing expression
+ examineCode [|| 3 + 4 ||] `bindCode` liftTyped
+ ======>
+ TExp
+ (InfixE
+ (Just (LitE (IntegerL 3)))
+ (VarE
+ (Name
+ (OccName "+")
+ (NameG
+ VarName (PkgName "ghc-internal") (ModName "GHC.Internal.Num"))))
+ (Just (LitE (IntegerL 4))))
=====================================
testsuite/tests/th/all.T
=====================================
@@ -318,7 +318,7 @@ test('T1476', normal, compile, ['-v0'])
test('T1476b', normal, compile, ['-v0'])
test('T8031', normal, compile, ['-v0'])
test('T8624', only_ways(['normal']), makefile_test, ['T8624'])
-test('TH_Lift', normal, compile, ['-v0'])
+test('TH_Lift', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script'])
test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script'])
test('T10267', [], multimod_compile_fail,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90eb495b75e5e7178a8855d403f9c74cff6914f9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/90eb495b75e5e7178a8855d403f9c74cff6914f9
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/20240614/6f377c1a/attachment-0001.html>
More information about the ghc-commits
mailing list