[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: base: Add inits1 and tails1 to Data.List
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Jun 22 03:39:49 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
033fce23 by Ryan Hendrickson at 2024-06-21T23:39:25-04:00
base: Add inits1 and tails1 to Data.List
- - - - -
b4c85b32 by Sebastian Graf at 2024-06-21T23:39:28-04:00
Derive previously hand-written `Lift` instances (#14030)
This is possible now that #22229 is fixed.
- - - - -
88ec3c24 by Sebastian Graf at 2024-06-21T23:39:28-04: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.
The residency of T24471 increases by 13% because we now load `AnnLookup`
from its interface file, which transitively loads the whole TH AST.
Unavoidable and not terrible, I think.
Metric Increase:
T24471
- - - - -
1d9c3590 by Peter Trommler at 2024-06-21T23:39:28-04:00
PPC NCG: Fix sign hints in C calls
Sign hints for parameters are in the second component of the pair.
Fixes #23034
- - - - -
e59207c3 by Matthew Pickering at 2024-06-21T23:39:29-04:00
bindist: Use complete relative paths when cding to directories
If a user has configured CDPATH on their system then `cd lib` may change
into an unexpected directory during the installation process.
If you write `cd ./lib` then it will not consult `CDPATH` to determine
what you mean.
I have added a check on ghcup-ci to verify that the bindist installation
works in this situation.
Fixes #24951
- - - - -
29 changed files:
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- hadrian/bindist/Makefile
- libraries/base/changelog.md
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/ghc-internal/ghc-internal.cabal
- + libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
- + testsuite/tests/codeGen/should_run/T23034.h
- + testsuite/tests/codeGen/should_run/T23034.hs
- + testsuite/tests/codeGen/should_run/T23034.stdout
- + testsuite/tests/codeGen/should_run/T23034_c.c
- testsuite/tests/codeGen/should_run/all.T
- testsuite/tests/ghci/scripts/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/lib/base/InitsTails.hs
- + testsuite/tests/lib/base/InitsTails.stdout
- testsuite/tests/lib/base/all.T
- testsuite/tests/th/TH_Lift.hs
- + testsuite/tests/th/TH_Lift.stderr
- testsuite/tests/th/all.T
- utils/haddock/html-test/ref/Identifiers.html
- utils/haddock/html-test/ref/Instances.html
Changes:
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -1770,7 +1770,7 @@ genCCall' config gcp target dest_regs args
_ -> panic "genCall': unknown calling conv."
argReps = map (cmmExprType platform) args
- (argHints, _) = foreignTargetHints target
+ (_, argHints) = foreignTargetHints target
roundTo a x | x `mod` a == 0 = x
| otherwise = x + a - (x `mod` a)
=====================================
hadrian/bindist/Makefile
=====================================
@@ -169,7 +169,7 @@ install_lib: lib/settings
$(INSTALL_DIR) "$(DESTDIR)$(ActualLibsDir)"
@dest="$(DESTDIR)$(ActualLibsDir)"; \
- cd lib; \
+ cd ./lib; \
for i in `$(FIND) . -type f`; do \
dir="`dirname $$i`" ; \
$(INSTALL_DIR) "$$dest/$$dir" ; \
@@ -197,7 +197,7 @@ install_docs:
$(INSTALL_DIR) "$(DESTDIR)$(docdir)"
if [ -d doc ]; then \
- cd doc; $(FIND) . -type f -exec sh -c \
+ cd ./doc; $(FIND) . -type f -exec sh -c \
'$(INSTALL_DIR) "$(DESTDIR)$(docdir)/`dirname $$1`" && $(INSTALL_DATA) "$$1" "$(DESTDIR)$(docdir)/`dirname $$1`"' \
sh '{}' ';'; \
fi
@@ -213,7 +213,7 @@ install_data:
@echo "Copying data to $(DESTDIR)share"
$(INSTALL_DIR) "$(DESTDIR)$(datadir)"
if [ -d share ]; then \
- cd share; $(FIND) . -type f -exec sh -c \
+ cd ./share; $(FIND) . -type f -exec sh -c \
'$(INSTALL_DIR) "$(DESTDIR)$(datadir)/`dirname $$1`" && \
$(INSTALL_DATA) "$$1" "$(DESTDIR)$(datadir)/`dirname $$1`"' \
sh '{}' ';'; \
@@ -235,7 +235,7 @@ export SHELL
install_wrappers: install_bin_libdir install_hsc2hs_wrapper
@echo "Installing wrapper scripts"
$(INSTALL_DIR) "$(DESTDIR)$(WrapperBinsDir)"
- for p in `cd wrappers; $(FIND) . ! -type d`; do \
+ for p in `cd ./wrappers; $(FIND) . ! -type d`; do \
mk/install_script.sh "$$p" "$(DESTDIR)/$(WrapperBinsDir)/$$p" "$(WrapperBinsDir)" "$(ActualBinsDir)" "$(ActualBinsDir)/$$p" "$(ActualLibsDir)" "$(docdir)" "$(includedir)"; \
done
=====================================
libraries/base/changelog.md
=====================================
@@ -8,6 +8,7 @@
* The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))
* Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
* Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))
+ * Add `inits1` and `tails1` to `Data.List`, factored from the corresponding functions in `Data.List.NonEmpty` ([CLC proposal #252](https://github.com/haskell/core-libraries-committee/issues/252))
* Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172))
## 4.20.0.0 *TBA*
=====================================
libraries/base/src/Data/List.hs
=====================================
@@ -83,7 +83,9 @@ module Data.List
stripPrefix,
group,
inits,
+ inits1,
tails,
+ tails1,
-- ** Predicates
isPrefixOf,
isSuffixOf,
@@ -177,3 +179,67 @@ module Data.List
) where
import GHC.Internal.Data.List
+import GHC.Internal.Data.List.NonEmpty (NonEmpty(..))
+import GHC.List (build)
+
+inits1, tails1 :: [a] -> [NonEmpty a]
+
+-- | The 'inits1' function returns all non-empty initial segments of the
+-- argument, shortest first.
+--
+-- @since 4.21.0.0
+--
+-- ==== __Laziness__
+--
+-- Note that 'inits1' has the following strictness property:
+-- @inits1 (xs ++ _|_) = inits1 xs ++ _|_@
+--
+-- In particular,
+-- @inits1 _|_ = _|_@
+--
+-- ==== __Examples__
+--
+-- >>> inits1 "abc"
+-- ['a' :| "",'a' :| "b",'a' :| "bc"]
+--
+-- >>> inits1 []
+-- []
+--
+-- inits1 is productive on infinite lists:
+--
+-- >>> take 3 $ inits1 [1..]
+-- [1 :| [],1 :| [2],1 :| [2,3]]
+inits1 [] = []
+inits1 (x : xs) = map (x :|) (inits xs)
+
+-- | \(\mathcal{O}(n)\). The 'tails1' function returns all non-empty final
+-- segments of the argument, longest first.
+--
+-- @since 4.21.0.0
+--
+-- ==== __Laziness__
+--
+-- Note that 'tails1' has the following strictness property:
+-- @tails1 _|_ = _|_@
+--
+-- >>> tails1 undefined
+-- *** Exception: Prelude.undefined
+--
+-- >>> drop 1 (tails1 [undefined, 1, 2])
+-- [1 :| [2],2 :| []]
+--
+-- ==== __Examples__
+--
+-- >>> tails1 "abc"
+-- ['a' :| "bc",'b' :| "c",'c' :| ""]
+--
+-- >>> tails1 [1, 2, 3]
+-- [1 :| [2,3],2 :| [3],3 :| []]
+--
+-- >>> tails1 []
+-- []
+{-# INLINABLE tails1 #-}
+tails1 lst = build (\c n ->
+ let tails1Go [] = n
+ tails1Go (x : xs) = (x :| xs) `c` tails1Go xs
+ in tails1Go lst)
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -109,10 +109,10 @@ import Prelude hiding (break, cycle, drop, dropWhile,
import qualified Prelude
import Control.Applicative (Applicative (..), Alternative (many))
+import qualified Data.List as List
import GHC.Internal.Data.Foldable hiding (length, toList)
import qualified GHC.Internal.Data.Foldable as Foldable
import GHC.Internal.Data.Function (on)
-import qualified GHC.Internal.Data.List as List
import GHC.Internal.Data.Ord (comparing)
import GHC.Internal.Base (NonEmpty(..))
import GHC.Internal.Stack.Types (HasCallStack)
@@ -273,15 +273,7 @@ inits = fromList . List.inits . Foldable.toList
--
-- @since 4.18
inits1 :: NonEmpty a -> NonEmpty (NonEmpty a)
-inits1 =
- -- fromList is an unsafe function, but this usage should be safe, since:
- -- * `inits xs = [[], ..., init (init xs), init xs, xs]`
- -- * If `xs` is nonempty, it follows that `inits xs` contains at least one nonempty
- -- list, since `last (inits xs) = xs`.
- -- * The only empty element of `inits xs` is the first one (by the definition of `inits`)
- -- * Therefore, if we take all but the first element of `inits xs` i.e.
- -- `tail (inits xs)`, we have a nonempty list of nonempty lists
- fromList . Prelude.map fromList . List.drop 1 . List.inits . Foldable.toList
+inits1 = fromList . List.inits1 . Foldable.toList
-- | The 'tails' function takes a stream @xs@ and returns all the
-- suffixes of @xs@, starting with the longest. The result is 'NonEmpty'
@@ -301,15 +293,7 @@ tails = fromList . List.tails . Foldable.toList
--
-- @since 4.18
tails1 :: NonEmpty a -> NonEmpty (NonEmpty a)
-tails1 =
- -- fromList is an unsafe function, but this usage should be safe, since:
- -- * `tails xs = [xs, tail xs, tail (tail xs), ..., []]`
- -- * If `xs` is nonempty, it follows that `tails xs` contains at least one nonempty
- -- list, since `head (tails xs) = xs`.
- -- * The only empty element of `tails xs` is the last one (by the definition of `tails`)
- -- * Therefore, if we take all but the last element of `tails xs` i.e.
- -- `init (tails xs)`, we have a nonempty list of nonempty lists
- fromList . Prelude.map fromList . List.init . List.tails . Foldable.toList
+tails1 = fromList . List.tails1 . Foldable.toList
-- | @'insert' x xs@ inserts @x@ into the last position in @xs@ where it
-- is still less than or equal to the next element. In particular, if the
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -122,6 +122,7 @@ Library
GHC.Internal.Data.IORef
GHC.Internal.Data.Ix
GHC.Internal.Data.List
+ GHC.Internal.Data.List.NonEmpty
GHC.Internal.Data.Maybe
GHC.Internal.Data.Monoid
GHC.Internal.Data.OldList
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/List/NonEmpty.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE Trustworthy #-}
+
+module GHC.Internal.Data.List.NonEmpty
+ ( NonEmpty(..)
+ ) where
+
+import GHC.Internal.Base
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -12,6 +12,9 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
-- | This module gives the definition of the 'Lift' class.
@@ -39,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
@@ -47,13 +50,13 @@ import GHC.Internal.Type.Reflection
import GHC.Internal.Data.Bool
import GHC.Internal.Base hiding (Type, Module, inline)
import GHC.Internal.Data.Foldable
-import GHC.Internal.Data.Functor
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
@@ -95,6 +98,11 @@ class Lift (t :: TYPE r) where
-- @since template-haskell-2.16.0.0
liftTyped :: Quote m => t -> Code m t
+-----------------------------------------------------
+--
+-- Manual instances for lifting to Literals
+--
+-----------------------------------------------------
-- If you add any instances here, consider updating test th/TH_Lift
instance Lift Integer where
@@ -186,12 +194,6 @@ instance Lift Char# where
liftTyped x = unsafeCodeCoerce (lift x)
lift x = return (LitE (CharPrimL (C# x)))
-instance Lift Bool where
- liftTyped x = unsafeCodeCoerce (lift x)
-
- lift True = return (ConE trueName)
- lift False = return (ConE falseName)
-
-- | Produces an 'Addr#' literal from the NUL-terminated C-string starting at
-- the given memory address.
--
@@ -201,18 +203,6 @@ instance Lift Addr# where
lift x
= return (LitE (StringPrimL (map (fromIntegral . ord) (unpackCString# x))))
-instance Lift a => Lift (Maybe a) where
- liftTyped x = unsafeCodeCoerce (lift x)
-
- lift Nothing = return (ConE nothingName)
- lift (Just x) = liftM (ConE justName `AppE`) (lift x)
-
-instance (Lift a, Lift b) => Lift (Either a b) where
- liftTyped x = unsafeCodeCoerce (lift x)
-
- lift (Left x) = liftM (ConE leftName `AppE`) (lift x)
- lift (Right y) = liftM (ConE rightName `AppE`) (lift y)
-
instance Lift a => Lift [a] where
liftTyped x = unsafeCodeCoerce (lift x)
lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
@@ -221,193 +211,85 @@ liftString :: Quote m => String -> m Exp
-- Used in GHC.Tc.Gen.Expr to short-circuit the lifting for strings
liftString s = return (LitE (StringL s))
--- | @since template-haskell-2.15.0.0
-instance Lift a => Lift (NonEmpty a) where
- liftTyped x = unsafeCodeCoerce (lift x)
+-- TH has a special form for literal strings,
+-- which we should take advantage of.
+-- NB: the lhs of the rule has no args, so that
+-- the rule will apply to a 'lift' all on its own
+-- which happens to be the way the type checker
+-- creates it.
+-- SG: This RULE is tested by T3600.
+-- In #24983 I advocated defining an overlapping instance
+-- to replace this RULE. However, doing so breaks drv023
+-- which would need to declare an instance derived from `Lift @[a]` as
+-- incoherent. So this RULE it is.
+{-# RULES "TH:liftString" lift = liftString #-}
- lift (x :| xs) = do
- x' <- lift x
- xs' <- lift xs
- return (InfixE (Just x') (ConE nonemptyName) (Just xs'))
+-----------------------------------------------------
+--
+-- Derived instances for base data types
+--
+-----------------------------------------------------
+deriving instance Lift Bool
+deriving instance Lift a => Lift (Maybe a)
+deriving instance (Lift a, Lift b) => Lift (Either a b)
-- | @since template-haskell-2.15.0.0
-instance Lift Void where
- liftTyped = liftCode . absurd
- lift = pure . absurd
-
-instance Lift () where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift () = return (ConE (tupleDataName 0))
-
-instance (Lift a, Lift b) => Lift (a, b) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b)
- = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b]
-
-instance (Lift a, Lift b, Lift c) => Lift (a, b, c) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b, c)
- = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
-
-instance (Lift a, Lift b, Lift c, Lift d) => Lift (a, b, c, d) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b, c, d)
- = liftM TupE $ sequence $ map (fmap Just) [lift a, lift b, lift c, lift d]
-
-instance (Lift a, Lift b, Lift c, Lift d, Lift e)
- => Lift (a, b, c, d, e) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b, c, d, e)
- = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b
- , lift c, lift d, lift e ]
-
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
- => Lift (a, b, c, d, e, f) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b, c, d, e, f)
- = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
- , lift d, lift e, lift f ]
-
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
- => Lift (a, b, c, d, e, f, g) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (a, b, c, d, e, f, g)
- = liftM TupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
- , lift d, lift e, lift f, lift g ]
-
+deriving instance Lift a => Lift (NonEmpty a)
+-- | @since template-haskell-2.15.0.0
+deriving instance Lift Void
+deriving instance Lift ()
+deriving instance (Lift a, Lift b)
+ => Lift (a, b)
+deriving instance (Lift a, Lift b, Lift c)
+ => Lift (a, b, c)
+deriving instance (Lift a, Lift b, Lift c, Lift d)
+ => Lift (a, b, c, d)
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
+ => Lift (a, b, c, d, e)
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
+ => Lift (a, b, c, d, e, f)
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
+ => Lift (a, b, c, d, e, f, g)
-- | @since template-haskell-2.16.0.0
-instance Lift (# #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# #) = return (ConE (unboxedTupleTypeName 0))
-
+deriving instance Lift (# #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a) => Lift (# a #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a]
-
+deriving instance (Lift a)
+ => Lift (# a #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b) => Lift (# a, b #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b]
-
+deriving instance (Lift a, Lift b)
+ => Lift (# a, b #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c)
- => Lift (# a, b, c #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b, c #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [lift a, lift b, lift c]
-
+deriving instance (Lift a, Lift b, Lift c)
+ => Lift (# a, b, c #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d)
- => Lift (# a, b, c, d #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b, c, d #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
- , lift c, lift d ]
-
+deriving instance (Lift a, Lift b, Lift c, Lift d)
+ => Lift (# a, b, c, d #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e)
- => Lift (# a, b, c, d, e #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b, c, d, e #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b
- , lift c, lift d, lift e ]
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
+ => Lift (# a, b, c, d, e #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
- => Lift (# a, b, c, d, e, f #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b, c, d, e, f #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
- , lift d, lift e, lift f ]
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
+ => Lift (# a, b, c, d, e, f #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
- => Lift (# a, b, c, d, e, f, g #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift (# a, b, c, d, e, f, g #)
- = liftM UnboxedTupE $ sequence $ map (fmap Just) [ lift a, lift b, lift c
- , lift d, lift e, lift f
- , lift g ]
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
+ => Lift (# a, b, c, d, e, f, g #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b) => Lift (# a | b #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 2
- (# | y #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 2
-
+deriving instance (Lift a, Lift b) => Lift (# a | b #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c)
- => Lift (# a | b | c #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 3
- (# | y | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 3
- (# | | y #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 3
-
+deriving instance (Lift a, Lift b, Lift c)
+ => Lift (# a | b | c #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d)
- => Lift (# a | b | c | d #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 4
- (# | y | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 4
- (# | | y | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 4
- (# | | | y #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 4
-
+deriving instance (Lift a, Lift b, Lift c, Lift d)
+ => Lift (# a | b | c | d #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e)
- => Lift (# a | b | c | d | e #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 5
- (# | y | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 5
- (# | | y | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 5
- (# | | | y | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 5
- (# | | | | y #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 5
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e)
+ => Lift (# a | b | c | d | e #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
- => Lift (# a | b | c | d | e | f #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 6
- (# | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 6
- (# | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 6
- (# | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 6
- (# | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 6
- (# | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 6
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f)
+ => Lift (# a | b | c | d | e | f #)
-- | @since template-haskell-2.16.0.0
-instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
- => Lift (# a | b | c | d | e | f | g #) where
- liftTyped x = unsafeCodeCoerce (lift x)
- lift x
- = case x of
- (# y | | | | | | #) -> UnboxedSumE <$> lift y <*> pure 1 <*> pure 7
- (# | y | | | | | #) -> UnboxedSumE <$> lift y <*> pure 2 <*> pure 7
- (# | | y | | | | #) -> UnboxedSumE <$> lift y <*> pure 3 <*> pure 7
- (# | | | y | | | #) -> UnboxedSumE <$> lift y <*> pure 4 <*> pure 7
- (# | | | | y | | #) -> UnboxedSumE <$> lift y <*> pure 5 <*> pure 7
- (# | | | | | y | #) -> UnboxedSumE <$> lift y <*> pure 6 <*> pure 7
- (# | | | | | | y #) -> UnboxedSumE <$> lift y <*> pure 7 <*> pure 7
-
--- TH has a special form for literal strings,
--- which we should take advantage of.
--- NB: the lhs of the rule has no args, so that
--- the rule will apply to a 'lift' all on its own
--- which happens to be the way the type checker
--- creates it.
-{-# RULES "TH:liftString" lift = \s -> return (LitE (StringL s)) #-}
-
+deriving instance (Lift a, Lift b, Lift c, Lift d, Lift e, Lift f, Lift g)
+ => Lift (# a | b | c | d | e | f | g #)
trueName, falseName :: Name
trueName = 'True
@@ -424,6 +306,141 @@ 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
+ liftTyped x = unsafeCodeCoerce (lift x)
+ lift bytes at 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/codeGen/should_run/T23034.h
=====================================
@@ -0,0 +1 @@
+void t_printf(signed long a, signed int b, signed short c, signed char d);
=====================================
testsuite/tests/codeGen/should_run/T23034.hs
=====================================
@@ -0,0 +1,8 @@
+module Main where
+
+import Foreign.C
+
+foreign import ccall unsafe "T23034.h t_printf"
+ t_printf :: CLong -> CInt -> CShort -> CSChar -> IO ()
+
+main = t_printf (-1) (-2) (-3) (-4)
=====================================
testsuite/tests/codeGen/should_run/T23034.stdout
=====================================
@@ -0,0 +1 @@
+-1 -2 -3 -4
=====================================
testsuite/tests/codeGen/should_run/T23034_c.c
=====================================
@@ -0,0 +1,6 @@
+#include "T23034.h"
+#include <stdio.h>
+
+void t_printf(signed long a, signed int b, signed short c, signed char d) {
+ printf("%d %d %d %d\n", a, b, c, d);
+}
=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -247,3 +247,4 @@ test('T24295b', normal, compile_and_run, ['-O -floopification -fpedantic-bottoms
test('T24664a', normal, compile_and_run, ['-O'])
test('T24664b', normal, compile_and_run, ['-O'])
test('CtzClz0', normal, compile_and_run, [''])
+test('T23034', normal, compile_and_run, ['-O2 T23034_c.c'])
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -369,8 +369,8 @@ test('T20909', normal, ghci_script, ['T20909.script'])
test('T20150', normal, ghci_script, ['T20150.script'])
test('T20974', normal, ghci_script, ['T20974.script'])
test('T21088', normal, ghci_script, ['T21088.script'])
-test('T21110', [extra_files(['T21110A.hs'])], ghci_script,
- ['T21110.script'])
+test('T21110', [extra_files(['T21110A.hs']), normalise_version('template-haskell')],
+ ghci_script, ['T21110.script'])
test('T17830', [filter_stdout_lines(r'======.*')], ghci_script, ['T17830.script'])
test('T21294a', normal, ghci_script, ['T21294a.script'])
test('T21507', normal, ghci_script, ['T21507.script'])
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
inits :: forall a. [a] -> [[a]]
+ inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
tails :: forall a. [a] -> [[a]]
+ tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
take :: forall a. GHC.Types.Int -> [a] -> [a]
takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
transpose :: forall a. [[a]] -> [[a]]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
inits :: forall a. [a] -> [[a]]
+ inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
tails :: forall a. [a] -> [[a]]
+ tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
take :: forall a. GHC.Types.Int -> [a] -> [a]
takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
transpose :: forall a. [[a]] -> [[a]]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
inits :: forall a. [a] -> [[a]]
+ inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
tails :: forall a. [a] -> [[a]]
+ tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
take :: forall a. GHC.Types.Int -> [a] -> [a]
takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
transpose :: forall a. [[a]] -> [[a]]
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -1332,6 +1332,7 @@ module Data.List where
head :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> a
init :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
inits :: forall a. [a] -> [[a]]
+ inits1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
insert :: forall a. GHC.Classes.Ord a => a -> [a] -> [a]
insertBy :: forall a. (a -> a -> GHC.Types.Ordering) -> a -> [a] -> [a]
intercalate :: forall a. [a] -> [[a]] -> [a]
@@ -1382,6 +1383,7 @@ module Data.List where
sum :: forall (t :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, GHC.Internal.Num.Num a) => t a -> a
tail :: forall a. GHC.Internal.Stack.Types.HasCallStack => [a] -> [a]
tails :: forall a. [a] -> [[a]]
+ tails1 :: forall a. [a] -> [GHC.Internal.Base.NonEmpty a]
take :: forall a. GHC.Types.Int -> [a] -> [a]
takeWhile :: forall a. (a -> GHC.Types.Bool) -> [a] -> [a]
transpose :: forall a. [[a]] -> [[a]]
=====================================
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/lib/base/InitsTails.hs
=====================================
@@ -0,0 +1,23 @@
+module Main (main) where
+
+import Data.List (inits, inits1, tails, tails1)
+
+main :: IO ()
+main = do
+ print $ inits "abc"
+ print $ inits ([] :: [Int])
+ print $ take 5 $ inits [1..]
+ print $ take 3 $ inits ([1, 2] ++ undefined)
+
+ print $ inits1 "abc"
+ print $ inits1 ([] :: [Int])
+ print $ take 3 $ inits1 [1..]
+ print $ take 2 $ inits1 ([1, 2] ++ undefined)
+
+ print $ tails "abc"
+ print $ tails ([] :: [Int])
+ print $ drop 1 (tails [undefined, 1, 2])
+
+ print $ tails1 "abc"
+ print $ tails1 ([] :: [Int])
+ print $ drop 1 (tails1 [undefined, 1, 2])
=====================================
testsuite/tests/lib/base/InitsTails.stdout
=====================================
@@ -0,0 +1,14 @@
+["","a","ab","abc"]
+[[]]
+[[],[1],[1,2],[1,2,3],[1,2,3,4]]
+[[],[1],[1,2]]
+['a' :| "",'a' :| "b",'a' :| "bc"]
+[]
+[1 :| [],1 :| [2],1 :| [2,3]]
+[1 :| [],1 :| [2]]
+["abc","bc","c",""]
+[[]]
+[[1,2],[2],[]]
+['a' :| "bc",'b' :| "c",'c' :| ""]
+[]
+[1 :| [2],2 :| []]
=====================================
testsuite/tests/lib/base/all.T
=====================================
@@ -12,3 +12,4 @@ test('Unsnoc', normal, compile_and_run, [''])
test('First-Semigroup-sconcat', normal, compile_and_run, [''])
test('First-Monoid-sconcat', normal, compile_and_run, [''])
test('Sort', normal, compile_and_run, [''])
+test('InitsTails', normal, compile_and_run, [''])
=====================================
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', js_broken(24886), 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,
=====================================
utils/haddock/html-test/ref/Identifiers.html
=====================================
@@ -142,7 +142,7 @@
><ul
><li
>Unqualified: <code
- ><a href="#" title="Data.List"
+ ><a href="#" title="GHC.List"
>++</a
></code
>, <code
@@ -162,7 +162,7 @@
></li
><li
>Namespaced: <code
- ><a href="#" title="Data.List"
+ ><a href="#" title="GHC.List"
>++</a
></code
>, <code class="inline-code"
@@ -199,7 +199,7 @@
><li
>Unqualified: <code class="inline-code"
><code
- ><a href="#" title="Data.List"
+ ><a href="#" title="GHC.List"
>(++)</a
></code
> [1,2,3] [4,5,6]</code
@@ -214,7 +214,7 @@
></li
><li
>Namespaced: <code
- ><a href="#" title="Data.List"
+ ><a href="#" title="GHC.List"
>(++)</a
></code
>, <code class="inline-code"
=====================================
utils/haddock/html-test/ref/Instances.html
=====================================
@@ -266,7 +266,7 @@
></span
> <a href="#" title="Instances"
>Foo</a
- > <a href="#" title="Data.List"
+ > <a href="#" title="GHC.Exts"
>[]</a
></span
> <a href="#" class="selflink"
@@ -910,7 +910,7 @@
></span
> <a href="#" title="Instances"
>Bar</a
- > <a href="#" title="Data.List"
+ > <a href="#" title="GHC.Exts"
>[]</a
> (a, a)</span
> <a href="#" class="selflink"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74c9ce12e072f8499f6a247d1f88f7726f401297...e59207c3061ec3eb3bab2ab33b3c0b1a87ee7b69
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/74c9ce12e072f8499f6a247d1f88f7726f401297...e59207c3061ec3eb3bab2ab33b3c0b1a87ee7b69
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/20240621/60bb8ea7/attachment-0001.html>
More information about the ghc-commits
mailing list