summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyanGlScott <ryan.gl.scott@gmail.com>2015-12-21 16:11:25 +0100
committerBen Gamari <ben@smart-cactus.org>2015-12-21 19:09:55 +0100
commitee6fba89b066fdf8408e6a18db343a4177e613f6 (patch)
treef60d6c0495bbfdaf29ff642caaf4deefb717b25d
parent99b956ef1d4bbb2252c0bbaa956094c2f837d111 (diff)
downloadhaskell-ee6fba89b066fdf8408e6a18db343a4177e613f6.tar.gz
Encode strictness in GHC generics metadata
This augments `MetaSel` with a `Bang` field, which gives generic programmers access to the following information about each field selector: * `SourceUnpackedness`: whether a field was marked `{-# NOUNPACK #-}`, `{-# UNPACK #-}`, or not * `SourceStrictness`: whether a field was given a strictness (`!`) or laziness (`~`) annotation * `DecidedStrictness`: what strictness GHC infers for a field during compilation, which may be influenced by optimization levels, `-XStrictData`, `-funbox-strict-fields`, etc. Unlike in Phab:D1603, generics does not grant a programmer the ability to "splice" in metadata, so there is no issue including `DecidedStrictness` with `Bang` (whereas in Template Haskell, it had to be split off). One consequence of this is that `MetaNoSel` had to be removed, since it became redundant. The `NoSelector` empty data type was also removed for similar reasons. Fixes #10716. Test Plan: ./validate Reviewers: dreixel, goldfire, kosmikus, austin, hvr, bgamari Reviewed By: bgamari Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D1646 GHC Trac Issues: #10716
Diffstat
-rw-r--r--compiler/prelude/PrelNames.hs48
-rw-r--r--compiler/prelude/TysWiredIn.hs8
-rw-r--r--compiler/typecheck/TcGenGenerics.hs72
-rw-r--r--docs/users_guide/7.12.1-notes.rst3
-rw-r--r--docs/users_guide/glasgow_exts.rst34
-rw-r--r--libraries/base/GHC/Generics.hs283
-rw-r--r--libraries/base/changelog.md5
-rw-r--r--testsuite/tests/generics/GFullyStrict.hs57
-rw-r--r--testsuite/tests/generics/GFullyStrict.stdout2
-rw-r--r--testsuite/tests/generics/GenDerivOutput.stderr50
-rw-r--r--testsuite/tests/generics/GenDerivOutput1_0.stderr28
-rw-r--r--testsuite/tests/generics/GenDerivOutput1_1.stderr200
-rw-r--r--testsuite/tests/generics/all.T2
13 files changed, 620 insertions, 172 deletions
diff --git a/compiler/prelude/PrelNames.hs b/compiler/prelude/PrelNames.hs
index a9f37aa49a..c83c73f52a 100644
--- a/compiler/prelude/PrelNames.hs
+++ b/compiler/prelude/PrelNames.hs
@@ -392,8 +392,11 @@ genericTyConNames = [
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
rightAssociativeDataConName, notAssociativeDataConName,
- metaDataDataConName, metaConsDataConName,
- metaSelDataConName, metaNoSelDataConName
+ sourceUnpackDataConName, sourceNoUnpackDataConName,
+ noSourceUnpackednessDataConName, sourceLazyDataConName,
+ sourceStrictDataConName, noSourceStrictnessDataConName,
+ decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,
+ metaDataDataConName, metaConsDataConName, metaSelDataConName
]
{-
@@ -873,8 +876,11 @@ v1TyConName, u1TyConName, par1TyConName, rec1TyConName,
uFloatTyConName, uIntTyConName, uWordTyConName,
prefixIDataConName, infixIDataConName, leftAssociativeDataConName,
rightAssociativeDataConName, notAssociativeDataConName,
- metaDataDataConName, metaConsDataConName,
- metaSelDataConName, metaNoSelDataConName :: Name
+ sourceUnpackDataConName, sourceNoUnpackDataConName,
+ noSourceUnpackednessDataConName, sourceLazyDataConName,
+ sourceStrictDataConName, noSourceStrictnessDataConName,
+ decidedLazyDataConName, decidedStrictDataConName, decidedUnpackDataConName,
+ metaDataDataConName, metaConsDataConName, metaSelDataConName :: Name
v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey
u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey
@@ -915,10 +921,19 @@ leftAssociativeDataConName = dcQual gHC_GENERICS (fsLit "LeftAssociative") le
rightAssociativeDataConName = dcQual gHC_GENERICS (fsLit "RightAssociative") rightAssociativeDataConKey
notAssociativeDataConName = dcQual gHC_GENERICS (fsLit "NotAssociative") notAssociativeDataConKey
+sourceUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceUnpack") sourceUnpackDataConKey
+sourceNoUnpackDataConName = dcQual gHC_GENERICS (fsLit "SourceNoUnpack") sourceNoUnpackDataConKey
+noSourceUnpackednessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceUnpackedness") noSourceUnpackednessDataConKey
+sourceLazyDataConName = dcQual gHC_GENERICS (fsLit "SourceLazy") sourceLazyDataConKey
+sourceStrictDataConName = dcQual gHC_GENERICS (fsLit "SourceStrict") sourceStrictDataConKey
+noSourceStrictnessDataConName = dcQual gHC_GENERICS (fsLit "NoSourceStrictness") noSourceStrictnessDataConKey
+decidedLazyDataConName = dcQual gHC_GENERICS (fsLit "DecidedLazy") decidedLazyDataConKey
+decidedStrictDataConName = dcQual gHC_GENERICS (fsLit "DecidedStrict") decidedStrictDataConKey
+decidedUnpackDataConName = dcQual gHC_GENERICS (fsLit "DecidedUnpack") decidedUnpackDataConKey
+
metaDataDataConName = dcQual gHC_GENERICS (fsLit "MetaData") metaDataDataConKey
metaConsDataConName = dcQual gHC_GENERICS (fsLit "MetaCons") metaConsDataConKey
metaSelDataConName = dcQual gHC_GENERICS (fsLit "MetaSel") metaSelDataConKey
-metaNoSelDataConName = dcQual gHC_GENERICS (fsLit "MetaNoSel") metaNoSelDataConKey
-- Base strings Strings
unpackCStringName, unpackCStringFoldrName,
@@ -1823,17 +1838,28 @@ typeErrorShowTypeDataConKey = mkPreludeDataConUnique 53
prefixIDataConKey, infixIDataConKey, leftAssociativeDataConKey,
rightAssociativeDataConKey, notAssociativeDataConKey,
- metaDataDataConKey, metaConsDataConKey,
- metaSelDataConKey, metaNoSelDataConKey :: Unique
+ sourceUnpackDataConKey, sourceNoUnpackDataConKey,
+ noSourceUnpackednessDataConKey, sourceLazyDataConKey,
+ sourceStrictDataConKey, noSourceStrictnessDataConKey,
+ decidedLazyDataConKey, decidedStrictDataConKey, decidedUnpackDataConKey,
+ metaDataDataConKey, metaConsDataConKey, metaSelDataConKey :: Unique
prefixIDataConKey = mkPreludeDataConUnique 54
infixIDataConKey = mkPreludeDataConUnique 55
leftAssociativeDataConKey = mkPreludeDataConUnique 56
rightAssociativeDataConKey = mkPreludeDataConUnique 57
notAssociativeDataConKey = mkPreludeDataConUnique 58
-metaDataDataConKey = mkPreludeDataConUnique 59
-metaConsDataConKey = mkPreludeDataConUnique 60
-metaSelDataConKey = mkPreludeDataConUnique 61
-metaNoSelDataConKey = mkPreludeDataConUnique 62
+sourceUnpackDataConKey = mkPreludeDataConUnique 59
+sourceNoUnpackDataConKey = mkPreludeDataConUnique 60
+noSourceUnpackednessDataConKey = mkPreludeDataConUnique 61
+sourceLazyDataConKey = mkPreludeDataConUnique 62
+sourceStrictDataConKey = mkPreludeDataConUnique 63
+noSourceStrictnessDataConKey = mkPreludeDataConUnique 64
+decidedLazyDataConKey = mkPreludeDataConUnique 65
+decidedStrictDataConKey = mkPreludeDataConUnique 66
+decidedUnpackDataConKey = mkPreludeDataConUnique 67
+metaDataDataConKey = mkPreludeDataConUnique 68
+metaConsDataConKey = mkPreludeDataConUnique 69
+metaSelDataConKey = mkPreludeDataConUnique 70
---------------- Template Haskell -------------------
-- THNames.hs: USES DataUniques 100-150
diff --git a/compiler/prelude/TysWiredIn.hs b/compiler/prelude/TysWiredIn.hs
index ab2371616c..368a56f367 100644
--- a/compiler/prelude/TysWiredIn.hs
+++ b/compiler/prelude/TysWiredIn.hs
@@ -54,7 +54,8 @@ module TysWiredIn (
-- * Maybe
maybeTyCon, maybeTyConName,
- nothingDataCon, nothingDataConName, justDataCon, justDataConName,
+ nothingDataCon, nothingDataConName, promotedNothingDataCon,
+ justDataCon, justDataConName, promotedJustDataCon,
-- * Tuples
mkTupleTy, mkBoxedTupleTy,
@@ -1046,6 +1047,11 @@ promotedFalseDataCon, promotedTrueDataCon :: TyCon
promotedTrueDataCon = promoteDataCon trueDataCon
promotedFalseDataCon = promoteDataCon falseDataCon
+-- Promoted Maybe
+promotedNothingDataCon, promotedJustDataCon :: TyCon
+promotedNothingDataCon = promoteDataCon nothingDataCon
+promotedJustDataCon = promoteDataCon justDataCon
+
-- Promoted Ordering
promotedLTDataCon
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index fb18517ad5..8c44467860 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -43,6 +43,7 @@ import FastString
import Util
import Control.Monad (mplus)
+import Data.List (zip4)
import Data.Maybe (isJust)
#include "HsVersions.h"
@@ -496,15 +497,23 @@ tc_mkRepTy gk_ tycon =
let tcLookupPromDataCon = fmap promoteDataCon . tcLookupDataCon
- md <- tcLookupPromDataCon metaDataDataConName
- mc <- tcLookupPromDataCon metaConsDataConName
- ms <- tcLookupPromDataCon metaSelDataConName
- mns <- tcLookupPromDataCon metaNoSelDataConName
- pPrefix <- tcLookupPromDataCon prefixIDataConName
- pInfix <- tcLookupPromDataCon infixIDataConName
- pLA <- tcLookupPromDataCon leftAssociativeDataConName
- pRA <- tcLookupPromDataCon rightAssociativeDataConName
- pNA <- tcLookupPromDataCon notAssociativeDataConName
+ md <- tcLookupPromDataCon metaDataDataConName
+ mc <- tcLookupPromDataCon metaConsDataConName
+ ms <- tcLookupPromDataCon metaSelDataConName
+ pPrefix <- tcLookupPromDataCon prefixIDataConName
+ pInfix <- tcLookupPromDataCon infixIDataConName
+ pLA <- tcLookupPromDataCon leftAssociativeDataConName
+ pRA <- tcLookupPromDataCon rightAssociativeDataConName
+ pNA <- tcLookupPromDataCon notAssociativeDataConName
+ pSUpk <- tcLookupPromDataCon sourceUnpackDataConName
+ pSNUpk <- tcLookupPromDataCon sourceNoUnpackDataConName
+ pNSUpkness <- tcLookupPromDataCon noSourceUnpackednessDataConName
+ pSLzy <- tcLookupPromDataCon sourceLazyDataConName
+ pSStr <- tcLookupPromDataCon sourceStrictDataConName
+ pNSStrness <- tcLookupPromDataCon noSourceStrictnessDataConName
+ pDLzy <- tcLookupPromDataCon decidedLazyDataConName
+ pDStr <- tcLookupPromDataCon decidedStrictDataConName
+ pDUpk <- tcLookupPromDataCon decidedUnpackDataConName
fix_env <- getFixityEnv
@@ -518,22 +527,26 @@ tc_mkRepTy gk_ tycon =
mkC a = mkTyConApp c1 [ metaConsTy a
, prod (dataConInstOrigArgTys a
. mkTyVarTys . tyConTyVars $ tycon)
+ (dataConSrcBangs a)
+ (dataConImplBangs a)
(dataConFieldLabels a)]
- mkS mlbl a = mkTyConApp s1 [metaSelTy mlbl, a]
+ mkS mlbl su ss ib a = mkTyConApp s1 [metaSelTy mlbl su ss ib, a]
-- Sums and products are done in the same way for both Rep and Rep1
sumP [] = mkTyConTy v1
sumP l = foldBal mkSum' . map mkC $ l
-- The Bool is True if this constructor has labelled fields
- prod :: [Type] -> [FieldLabel] -> Type
- prod [] _ = mkTyConTy u1
- prod l fl = foldBal mkProd [ ASSERT(null fl || length fl > j)
- arg t (if null fl then Nothing
+ prod :: [Type] -> [HsSrcBang] -> [HsImplBang] -> [FieldLabel] -> Type
+ prod [] _ _ _ = mkTyConTy u1
+ prod l sb ib fl = foldBal mkProd
+ [ ASSERT(null fl || length fl > j)
+ arg t sb' ib' (if null fl
+ then Nothing
else Just (fl !! j))
- | (t,j) <- zip l [0..] ]
+ | (t,sb',ib',j) <- zip4 l sb ib [0..] ]
- arg :: Type -> Maybe FieldLabel -> Type
- arg t fl = mkS fl $ case gk_ of
+ arg :: Type -> HsSrcBang -> HsImplBang -> Maybe FieldLabel -> Type
+ arg t (HsSrcBang _ su ss) ib fl = mkS fl su ss ib $ case gk_ of
-- Here we previously used Par0 if t was a type variable, but we
-- realized that we can't always guarantee that we are wrapping-up
-- all type variables in Par0. So we decided to stop using Par0
@@ -580,10 +593,29 @@ tc_mkRepTy gk_ tycon =
selName = mkStrLitTy . flLabel
+ mbSel Nothing = mkTyConApp promotedNothingDataCon [typeSymbolKind]
+ mbSel (Just s) = mkTyConApp promotedJustDataCon
+ [typeSymbolKind, selName s]
+
metaDataTy = mkTyConApp md [dtName, mdName, pkgName, isNT]
metaConsTy c = mkTyConApp mc [ctName c, ctFix c, isRec c]
- metaSelTy Nothing = mkTyConTy mns
- metaSelTy (Just s) = mkTyConApp ms [selName s]
+ metaSelTy mlbl su ss ib =
+ mkTyConApp ms [mbSel mlbl, pSUpkness, pSStrness, pDStrness]
+ where
+ pSUpkness = mkTyConTy $ case su of
+ SrcUnpack -> pSUpk
+ SrcNoUnpack -> pSNUpk
+ NoSrcUnpack -> pNSUpkness
+
+ pSStrness = mkTyConTy $ case ss of
+ SrcLazy -> pSLzy
+ SrcStrict -> pSStr
+ NoSrcStrict -> pNSStrness
+
+ pDStrness = mkTyConTy $ case ib of
+ HsLazy -> pDLzy
+ HsStrict -> pDStr
+ HsUnpack{} -> pDUpk
return (mkD tycon)
@@ -607,7 +639,7 @@ mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 ty
| ty `eqType` floatPrimTy = mkTyConTy uFloat
| ty `eqType` intPrimTy = mkTyConTy uInt
| ty `eqType` wordPrimTy = mkTyConTy uWord
- | otherwise = mkTyConApp rec0 [ty]
+ | otherwise = mkTyConApp rec0 [ty]
--------------------------------------------------------------------------------
-- Dealing with sums
diff --git a/docs/users_guide/7.12.1-notes.rst b/docs/users_guide/7.12.1-notes.rst
index 87f92f472d..9bac1c556f 100644
--- a/docs/users_guide/7.12.1-notes.rst
+++ b/docs/users_guide/7.12.1-notes.rst
@@ -105,6 +105,9 @@ Language
arguments with certain unlifted types. See :ref:`generic-programming` for
more details.
+- GHC generics can now provide strictness information for fields in a data
+ constructor via the ``Selector`` type class.
+
- The ``-XDeriveAnyClass`` extension now fills in associated type family
default instances when deriving a class that contains them.
diff --git a/docs/users_guide/glasgow_exts.rst b/docs/users_guide/glasgow_exts.rst
index 9b0ad3ef1e..f28295a86f 100644
--- a/docs/users_guide/glasgow_exts.rst
+++ b/docs/users_guide/glasgow_exts.rst
@@ -12530,11 +12530,23 @@ representation:
instance Generic (UserTree a) where
-- Representation type
type Rep (UserTree a) =
- M1 D ('MetaData "UserTree" "Main" "package-name" "foo" 'False) (
+ M1 D ('MetaData "UserTree" "Main" "package-name" 'False) (
M1 C ('MetaCons "Node" 'PrefixI 'False) (
- M1 S 'MetaNoSel (K1 R a)
- :*: M1 S 'MetaNoSel (K1 R (UserTree a))
- :*: M1 S 'MetaNoSel (K1 R (UserTree a)))
+ M1 S ('MetaSel 'Nothing
+ 'NoSourceUnpackedness
+ 'NoSourceStrictness
+ 'DecidedLazy)
+ (K1 R a)
+ :*: M1 S ('MetaSel 'Nothing
+ 'NoSourceUnpackedness
+ 'NoSourceStrictness
+ 'DecidedLazy)
+ (K1 R (UserTree a))
+ :*: M1 S ('MetaSel 'Nothing
+ 'NoSourceUnpackedness
+ 'NoSourceStrictness
+ 'DecidedLazy)
+ (K1 R (UserTree a)))
:+: M1 C ('MetaCons "Leaf" 'PrefixI 'False) U1)
-- Conversion functions
@@ -12612,11 +12624,15 @@ As an example, this data declaration: ::
results in the following ``Generic`` instance: ::
- instance Generic IntHash where
- type Rep IntHash =
- D1 D1IntHash
- (C1 C1_0IntHash
- (S1 NoSelector UInt))
+ instance 'Generic' IntHash where
+ type 'Rep' IntHash =
+ 'D1' ('MetaData "IntHash" "Main" "package-name" 'False)
+ ('C1' ('MetaCons "IntHash" 'PrefixI 'False)
+ ('S1' ('MetaSel 'Nothing
+ 'NoSourceUnpackedness
+ 'NoSourceStrictness
+ 'DecidedLazy)
+ 'UInt'))
A user could provide, for example, a ``GSerialize UInt`` instance so that a
``Serialize IntHash`` instance could be easily defined in terms of
diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs
index 67b98be5ee..16e61f9457 100644
--- a/libraries/base/GHC/Generics.hs
+++ b/libraries/base/GHC/Generics.hs
@@ -1,21 +1,20 @@
-{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CPP #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE PolyKinds #-}
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
@@ -75,12 +74,24 @@ module GHC.Generics (
-- type 'Rep' (Tree a) =
-- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False)
-- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel ('Rec0' a))
+-- ('S1' '(MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec0' a))
-- ':+:'
-- 'C1' ('MetaCons \"Node\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel ('Rec0' (Tree a))
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec0' (Tree a))
-- ':*:'
--- 'S1' 'MetaNoSel ('Rec0' (Tree a))))
+-- 'S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec0' (Tree a))))
-- ...
-- @
--
@@ -114,8 +125,27 @@ module GHC.Generics (
--
-- Now let us explain the additional tags being used in the complete representation:
--
--- * The @'S1' 'MetaNoSel@ indicates that there is no record field selector
--- associated with this field of the constructor.
+-- * The @'S1' ('MetaSel 'Nothing 'NoSourceUnpackedness 'NoSourceStrictness
+-- 'DecidedLazy)@ tag indicates several things. The @'Nothing@ indicates
+-- that there is no record field selector associated with this field of
+-- the constructor (if there were, it would have been marked @'Just
+-- \"recordName\"@ instead). The other types contain meta-information on
+-- the field's strictness:
+--
+-- * There is no @{\-\# UNPACK \#-\}@ or @{\-\# NOUNPACK \#-\}@ annotation
+-- in the source, so it is tagged with @'NoSourceUnpackedness@.
+--
+-- * There is no strictness (@!@) or laziness (@~@) annotation in the
+-- source, so it is tagged with @'NoSourceStrictness@.
+--
+-- * The compiler infers that the field is lazy, so it is tagged with
+-- @'DecidedLazy@. Bear in mind that what the compiler decides may be
+-- quite different from what is written in the source. See
+-- 'DecidedStrictness' for a more detailed explanation.
+--
+-- The @'MetaSel@ type is also an instance of the type class 'Selector',
+-- which can be used to obtain information about the field at the value
+-- level.
--
-- * The @'C1' ('MetaCons \"Leaf\" 'PrefixI 'False)@ and
-- @'C1' ('MetaCons \"Node\" 'PrefixI 'False)@ invocations indicate that the enclosed part is
@@ -462,12 +492,24 @@ module GHC.Generics (
-- type 'Rep1' Tree =
-- 'D1' ('MetaData \"Tree\" \"Main\" \"package-name\" 'False)
-- ('C1' ('MetaCons \"Leaf\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel 'Par1')
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- 'Par1')
-- ':+:'
-- 'C1' ('MetaCons \"Node\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel ('Rec1' Tree)
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec1' Tree)
-- ':*:'
--- 'S1' 'MetaNoSel ('Rec1' Tree)))
+-- 'S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec1' Tree)))
-- ...
-- @
--
@@ -513,9 +555,17 @@ module GHC.Generics (
-- type 'Rep1' WithInt =
-- 'D1' ('MetaData \"WithInt\" \"Main\" \"package-name\" 'False)
-- ('C1' ('MetaCons \"WithInt\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel ('Rec0' Int)
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ('Rec0' Int)
-- ':*:'
--- 'S1' 'MetaNoSel 'Par1'))
+-- 'S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- 'Par1'))
-- @
--
-- If the parameter @a@ appears underneath a composition of other type constructors,
@@ -532,9 +582,17 @@ module GHC.Generics (
-- type 'Rep1' Rose =
-- 'D1' ('MetaData \"Rose\" \"Main\" \"package-name\" 'False)
-- ('C1' ('MetaCons \"Fork\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel 'Par1'
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- 'Par1'
-- ':*:'
--- 'S1' 'MetaNoSel ([] ':.:' 'Rec1' Rose)
+-- 'S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- ([] ':.:' 'Rec1' Rose)))
-- @
--
-- where
@@ -596,7 +654,11 @@ module GHC.Generics (
-- type 'Rep' IntHash =
-- 'D1' ('MetaData \"IntHash\" \"Main\" \"package-name\" 'False)
-- ('C1' ('MetaCons \"IntHash\" 'PrefixI 'False)
--- ('S1' 'MetaNoSel 'UInt'))
+-- ('S1' ('MetaSel 'Nothing
+-- 'NoSourceUnpackedness
+-- 'NoSourceStrictness
+-- 'DecidedLazy)
+-- 'UInt'))
-- @
--
-- Currently, only the six unlifted types listed above are generated, but this
@@ -627,8 +689,9 @@ module GHC.Generics (
, D1, C1, S1, D, C, S
-- * Meta-information
- , Datatype(..), Constructor(..), Selector(..), NoSelector
+ , Datatype(..), Constructor(..), Selector(..)
, Fixity(..), FixityI(..), Associativity(..), prec
+ , SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..)
, Meta(..)
-- * Generic type classes
@@ -641,10 +704,11 @@ import GHC.Integer ( Integer, integerToInt )
import GHC.Prim ( Addr#, Char#, Double#, Float#, Int#, Word# )
import GHC.Ptr ( Ptr )
import GHC.Types
-import Data.Maybe ( Maybe(..) )
+import Data.Maybe ( Maybe(..), fromMaybe )
import Data.Either ( Either(..) )
-- Needed for instances
+import GHC.Base ( String )
import GHC.Classes ( Eq, Ord )
import GHC.Read ( Read )
import GHC.Show ( Show )
@@ -814,22 +878,78 @@ data Associativity = LeftAssociative
| NotAssociative
deriving (Eq, Show, Ord, Read, Generic)
+-- | The unpackedness of a field as the user wrote it in the source code. For
+-- example, in the following data type:
+--
+-- @
+-- data E = ExampleConstructor Int
+-- {\-\# NOUNPACK \#-\} Int
+-- {\-\# UNPACK \#-\} Int
+-- @
+--
+-- The fields of @ExampleConstructor@ have 'NoSourceUnpackedness',
+-- 'SourceNoUnpack', and 'SourceUnpack', respectively.
+data SourceUnpackedness = NoSourceUnpackedness
+ | SourceNoUnpack
+ | SourceUnpack
+ deriving (Eq, Show, Ord, Read, Generic)
+
+-- | The strictness of a field as the user wrote it in the source code. For
+-- example, in the following data type:
+--
+-- @
+-- data E = ExampleConstructor Int ~Int !Int
+-- @
+--
+-- The fields of @ExampleConstructor@ have 'NoSourceStrictness',
+-- 'SourceLazy', and 'SourceStrict', respectively.
+data SourceStrictness = NoSourceStrictness
+ | SourceLazy
+ | SourceStrict
+ deriving (Eq, Show, Ord, Read, Generic)
+
+-- | The strictness that GHC infers for a field during compilation. Whereas
+-- there are nine different combinations of 'SourceUnpackedness' and
+-- 'SourceStrictness', the strictness that GHC decides will ultimately be one
+-- of lazy, strict, or unpacked. What GHC decides is affected both by what the
+-- user writes in the source code and by GHC flags. As an example, consider
+-- this data type:
+--
+-- @
+-- data E = ExampleConstructor {\-\# UNPACK \#-\} !Int !Int Int
+-- @
+--
+-- * If compiled without optimization or other language extensions, then the
+-- fields of @ExampleConstructor@ will have 'DecidedStrict', 'DecidedStrict',
+-- and 'DecidedLazy', respectively.
+--
+-- * If compiled with @-XStrictData@ enabled, then the fields will have
+-- 'DecidedStrict', 'DecidedStrict', and 'DecidedStrict', respectively.
+--
+-- * If compiled with @-O2@ enabled, then the fields will have 'DecidedUnpack',
+-- 'DecidedStrict', and 'DecidedLazy', respectively.
+data DecidedStrictness = DecidedLazy
+ | DecidedStrict
+ | DecidedUnpack
+ deriving (Eq, Show, Ord, Read, Generic)
+
-- | Class for datatypes that represent records
class Selector s where
-- | The name of the selector
selName :: t s (f :: * -> *) a -> [Char]
-
--- | Used for constructor fields without a name
--- Deprecated in 7.9
-{-# DEPRECATED NoSelector "'NoSelector' is no longer used" #-}
-data NoSelector
-instance Selector NoSelector where selName _ = ""
-
-instance (KnownSymbol s) => Selector ('MetaSel s) where
- selName _ = symbolVal (Proxy :: Proxy s)
-
-instance Selector 'MetaNoSel where
- selName _ = ""
+ -- | The selector's unpackedness annotation (if any)
+ selSourceUnpackedness :: t s (f :: * -> *) a -> SourceUnpackedness
+ -- | The selector's strictness annotation (if any)
+ selSourceStrictness :: t s (f :: * -> *) a -> SourceStrictness
+ -- | The strictness that the compiler inferred for the selector
+ selDecidedStrictness :: t s (f :: * -> *) a -> DecidedStrictness
+
+instance (SingI mn, SingI su, SingI ss, SingI ds)
+ => Selector ('MetaSel mn su ss ds) where
+ selName _ = fromMaybe "" (fromSing (sing :: Sing mn))
+ selSourceUnpackedness _ = fromSing (sing :: Sing su)
+ selSourceStrictness _ = fromSing (sing :: Sing ss)
+ selDecidedStrictness _ = fromSing (sing :: Sing ds)
-- | Representable types of kind *.
-- This class is derivable in GHC with the DeriveGeneric flag on.
@@ -857,7 +977,7 @@ class Generic1 f where
--------------------------------------------------------------------------------
-- | Datatype to represent metadata associated with a datatype (@MetaData@),
--- constructor (@MetaCons@), or field (@MetaSel@ and @MetaNoSel@).
+-- constructor (@MetaCons@), or field selector (@MetaSel@).
--
-- * In @MetaData n m p nt@, @n@ is the datatype's name, @m@ is the module in
-- which the datatype is defined, @p@ is the package in which the datatype
@@ -866,14 +986,14 @@ class Generic1 f where
-- * In @MetaCons n f s@, @n@ is the constructor's name, @f@ is its fixity,
-- and @s@ is @'True@ if the constructor contains record selectors.
--
--- * Fields with record selectors are tagged with @MetaSel s@, where @s@ is
--- the record selector name.
---
--- * Fields without record selectors are tagged with @MetaNoSel@.
+-- * In @MetaSel mn su ss ds@, if the field is uses record syntax, then @mn@ is
+-- 'Just' the record name. Otherwise, @mn@ is 'Nothing. @su@ and @ss@ are the
+-- field's unpackedness and strictness annotations, and @ds@ is the
+-- strictness that GHC infers for the field.
data Meta = MetaData Symbol Symbol Symbol Bool
| MetaCons Symbol FixityI Bool
- | MetaSel Symbol
- | MetaNoSel
+ | MetaSel (Maybe Symbol)
+ SourceUnpackedness SourceStrictness DecidedStrictness
--------------------------------------------------------------------------------
-- Derived instances
@@ -930,6 +1050,16 @@ class (kparam ~ 'KProxy) => SingKind (kparam :: KProxy k) where
-- | Convert a singleton to its unrefined version.
fromSing :: Sing (a :: k) -> DemoteRep kparam
+-- Singleton symbols
+data instance Sing (_s :: Symbol) where
+ SSym :: KnownSymbol s => Sing s
+
+instance KnownSymbol a => SingI a where sing = SSym
+
+instance SingKind ('KProxy :: KProxy Symbol) where
+ type DemoteRep ('KProxy :: KProxy Symbol) = String
+ fromSing (SSym :: Sing s) = symbolVal (Proxy :: Proxy s)
+
-- Singleton booleans
data instance Sing (_a :: Bool) where
STrue :: Sing 'True
@@ -943,6 +1073,21 @@ instance SingKind ('KProxy :: KProxy Bool) where
fromSing STrue = True
fromSing SFalse = False
+-- Singleton Maybe
+data instance Sing (_b :: Maybe _a) where
+ SNothing :: Sing 'Nothing
+ SJust :: Sing a -> Sing ('Just a)
+
+instance SingI 'Nothing where sing = SNothing
+instance SingI a => SingI ('Just a) where sing = SJust sing
+
+instance SingKind ('KProxy :: KProxy a) =>
+ SingKind ('KProxy :: KProxy (Maybe a)) where
+ type DemoteRep ('KProxy :: KProxy (Maybe a)) =
+ Maybe (DemoteRep ('KProxy :: KProxy a))
+ fromSing SNothing = Nothing
+ fromSing (SJust a) = Just (fromSing a)
+
-- Singleton Fixity
data instance Sing (_a :: FixityI) where
SPrefix :: Sing 'PrefixI
@@ -972,3 +1117,51 @@ instance SingKind ('KProxy :: KProxy Associativity) where
fromSing SLeftAssociative = LeftAssociative
fromSing SRightAssociative = RightAssociative
fromSing SNotAssociative = NotAssociative
+
+-- Singleton SourceUnpackedness
+data instance Sing (_a :: SourceUnpackedness) where
+ SNoSourceUnpackedness :: Sing 'NoSourceUnpackedness
+ SSourceNoUnpack :: Sing 'SourceNoUnpack
+ SSourceUnpack :: Sing 'SourceUnpack
+
+instance SingI 'NoSourceUnpackedness where sing = SNoSourceUnpackedness
+instance SingI 'SourceNoUnpack where sing = SSourceNoUnpack
+instance SingI 'SourceUnpack where sing = SSourceUnpack
+
+instance SingKind ('KProxy :: KProxy SourceUnpackedness) where
+ type DemoteRep ('KProxy :: KProxy SourceUnpackedness) = SourceUnpackedness
+ fromSing SNoSourceUnpackedness = NoSourceUnpackedness
+ fromSing SSourceNoUnpack = SourceNoUnpack
+ fromSing SSourceUnpack = SourceUnpack
+
+-- Singleton SourceStrictness
+data instance Sing (_a :: SourceStrictness) where
+ SNoSourceStrictness :: Sing 'NoSourceStrictness
+ SSourceLazy :: Sing 'SourceLazy
+ SSourceStrict :: Sing 'SourceStrict
+
+instance SingI 'NoSourceStrictness where sing = SNoSourceStrictness
+instance SingI 'SourceLazy where sing = SSourceLazy
+instance SingI 'SourceStrict where sing = SSourceStrict
+
+instance SingKind ('KProxy :: KProxy SourceStrictness) where
+ type DemoteRep ('KProxy :: KProxy SourceStrictness) = SourceStrictness
+ fromSing SNoSourceStrictness = NoSourceStrictness
+ fromSing SSourceLazy = SourceLazy
+ fromSing SSourceStrict = SourceStrict
+
+-- Singleton DecidedStrictness
+data instance Sing (_a :: DecidedStrictness) where
+ SDecidedLazy :: Sing 'DecidedLazy
+ SDecidedStrict :: Sing 'DecidedStrict
+ SDecidedUnpack :: Sing 'DecidedUnpack
+
+instance SingI 'DecidedLazy where sing = SDecidedLazy
+instance SingI 'DecidedStrict where sing = SDecidedStrict
+instance SingI 'DecidedUnpack where sing = SDecidedUnpack
+
+instance SingKind ('KProxy :: KProxy DecidedStrictness) where
+ type DemoteRep ('KProxy :: KProxy DecidedStrictness) = DecidedStrictness
+ fromSing SDecidedLazy = DecidedLazy
+ fromSing SDecidedStrict = DecidedStrict
+ fromSing SDecidedUnpack = DecidedUnpack
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index fa57556de2..96df6bba5d 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -78,6 +78,11 @@
super-class of `Monoid` in the future). These modules were
provided by the `semigroups` package previously. (#10365)
+ * Add `selSourceUnpackedness`, `selSourceStrictness`, and
+ `selDecidedStrictness`, three functions which look up strictness
+ information of a field in a data constructor, to the `Selector` type class
+ in `GHC.Generics` (#10716)
+
* Add `URec`, `UAddr`, `UChar`, `UDouble`, `UFloat`, `UInt`, and `UWord` to
`GHC.Generics` as part of making GHC generics capable of handling
unlifted types (#10868)
diff --git a/testsuite/tests/generics/GFullyStrict.hs b/testsuite/tests/generics/GFullyStrict.hs
new file mode 100644
index 0000000000..7c879d9877
--- /dev/null
+++ b/testsuite/tests/generics/GFullyStrict.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+module Main where
+
+import Data.Proxy (Proxy(..))
+import GHC.Generics
+
+main :: IO ()
+main = do
+ print (fullyStrict (Proxy :: Proxy (StrictMaybe Bool)))
+ print (fullyStrict (Proxy :: Proxy (Maybe Bool)))
+
+data StrictMaybe a = StrictNothing | StrictJust !a
+ deriving (FullyStrict, Generic)
+
+instance FullyStrict Bool
+instance FullyStrict a => FullyStrict (Maybe a)
+
+class FullyStrict a where
+ fullyStrict :: proxy a -> Bool
+ default fullyStrict :: (GFullyStrict (Rep a)) => proxy a -> Bool
+ fullyStrict _ = gfullyStrict (Proxy :: Proxy (Rep a p))
+
+class GFullyStrict f where
+ gfullyStrict :: proxy (f p) -> Bool
+
+instance GFullyStrict V1 where
+ gfullyStrict _ = True
+
+instance GFullyStrict U1 where
+ gfullyStrict _ = True
+
+instance FullyStrict c => GFullyStrict (Rec0 c) where
+ gfullyStrict _ = fullyStrict (Proxy :: Proxy c)
+
+instance GFullyStrict f => GFullyStrict (D1 c f) where
+ gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))
+
+instance GFullyStrict f => GFullyStrict (C1 c f) where
+ gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))
+
+instance (GFullyStrict f, Selector c) => GFullyStrict (S1 c f) where
+ gfullyStrict _ = gfullyStrict (Proxy :: Proxy (f p))
+ && selDecidedStrictness (undefined :: S1 c f p) /= DecidedLazy
+
+instance (GFullyStrict f, GFullyStrict g) => GFullyStrict (f :+: g) where
+ gfullyStrict _ =
+ gfullyStrict (Proxy :: Proxy (f p)) && gfullyStrict (Proxy :: Proxy (g p))
+
+instance (GFullyStrict f, GFullyStrict g) => GFullyStrict (f :*: g) where
+ gfullyStrict _ =
+ gfullyStrict (Proxy :: Proxy (f p)) && gfullyStrict (Proxy :: Proxy (g p))
diff --git a/testsuite/tests/generics/GFullyStrict.stdout b/testsuite/tests/generics/GFullyStrict.stdout
new file mode 100644
index 0000000000..1cc8b5e10d
--- /dev/null
+++ b/testsuite/tests/generics/GFullyStrict.stdout
@@ -0,0 +1,2 @@
+True
+False
diff --git a/testsuite/tests/generics/GenDerivOutput.stderr b/testsuite/tests/generics/GenDerivOutput.stderr
index 6197da3d03..de11f431e9 100644
--- a/testsuite/tests/generics/GenDerivOutput.stderr
+++ b/testsuite/tests/generics/GenDerivOutput.stderr
@@ -109,11 +109,19 @@ GHC.Generics representation types:
'GHC.Types.True)
(GHC.Generics.S1
('GHC.Generics.MetaSel
- "element")
+ ('GHC.Base.Just
+ "element")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0 a)
GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "rest")
+ ('GHC.Base.Just
+ "rest")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
(GenDerivOutput.List
a))))
@@ -131,11 +139,19 @@ GHC.Generics representation types:
'GHC.Types.True)
(GHC.Generics.S1
('GHC.Generics.MetaSel
- "element")
+ ('GHC.Base.Just
+ "element")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
GHC.Generics.Par1
GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "rest")
+ ('GHC.Base.Just
+ "rest")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec1
GenDerivOutput.List)))
type GHC.Generics.Rep (GenDerivOutput.Rose a) = GHC.Generics.D1
@@ -156,10 +172,18 @@ GHC.Generics representation types:
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- 'GHC.Generics.MetaNoSel
+ ('GHC.Generics.MetaSel
+ 'GHC.Base.Nothing
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0 a)
GHC.Generics.:*: GHC.Generics.S1
- 'GHC.Generics.MetaNoSel
+ ('GHC.Generics.MetaSel
+ 'GHC.Base.Nothing
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GHC.Generics.Rec0
(GenDerivOutput.List
(GenDerivOutput.Rose
@@ -179,10 +203,20 @@ GHC.Generics representation types:
'GHC.Generics.PrefixI
'GHC.Types.False)
(GHC.Generics.S1
- 'GHC.Generics.MetaNoSel
+ ('GHC.Generics.MetaSel
+ 'GHC.Base.Nothing
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
GHC.Generics.Par1
GHC.Generics.:*: GHC.Generics.S1
- 'GHC.Generics.MetaNoSel
+ ('GHC.Generics.MetaSel
+ 'GHC.Base.Nothing
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
(GenDerivOutput.List
GHC.Generics.:.: GHC.Generics.Rec1
GenDerivOutput.Rose)))
+
+
diff --git a/testsuite/tests/generics/GenDerivOutput1_0.stderr b/testsuite/tests/generics/GenDerivOutput1_0.stderr
index 0757b128ca..0f4df6275a 100644
--- a/testsuite/tests/generics/GenDerivOutput1_0.stderr
+++ b/testsuite/tests/generics/GenDerivOutput1_0.stderr
@@ -23,31 +23,39 @@ Derived instances:
GHC.Generics representation types:
- type GHC.Generics.Rep1 GenDerivOutput1_0.List = GHC.Generics.D1
+ type GHC.Generics.Rep1 GenDerivOutput1_0.List = GHC.Generics.D1
('GHC.Generics.MetaData
"List"
"GenDerivOutput1_0"
"main"
'GHC.Types.False)
- (GHC.Generics.C1
+ (GHC.Generics.C1
('GHC.Generics.MetaCons
"Nil"
'GHC.Generics.PrefixI
'GHC.Types.False)
GHC.Generics.U1
- GHC.Generics.:+: GHC.Generics.C1
+ GHC.Generics.:+: GHC.Generics.C1
('GHC.Generics.MetaCons
"Cons"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
+ (GHC.Generics.S1
('GHC.Generics.MetaSel
- "element")
- GHC.Generics.Par1
- GHC.Generics.:*: GHC.Generics.S1
+ ('GHC.Base.Just
+ "element")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ GHC.Generics.Par1
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "rest")
- (GHC.Generics.Rec1
- GenDerivOutput1_0.List)))
+ ('GHC.Base.Just
+ "rest")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec1
+ GenDerivOutput1_0.List)))
diff --git a/testsuite/tests/generics/GenDerivOutput1_1.stderr b/testsuite/tests/generics/GenDerivOutput1_1.stderr
index 736637f6c2..d76d6bb593 100644
--- a/testsuite/tests/generics/GenDerivOutput1_1.stderr
+++ b/testsuite/tests/generics/GenDerivOutput1_1.stderr
@@ -155,7 +155,7 @@ Derived instances:
GHC.Generics representation types:
- type GHC.Generics.Rep1 CanDoRep1_1.Dd = GHC.Generics.D1
+ type GHC.Generics.Rep1 CanDoRep1_1.Dd = GHC.Generics.D1
('GHC.Generics.MetaData
"Dd" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -167,15 +167,23 @@ GHC.Generics representation types:
"D1d"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11d")
- GHC.Generics.Par1
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11d")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ GHC.Generics.Par1
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12d")
- (GHC.Generics.Rec1
- CanDoRep1_1.Dd)))
- type GHC.Generics.Rep (CanDoRep1_1.Dd a) = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12d")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec1
+ CanDoRep1_1.Dd)))
+ type GHC.Generics.Rep (CanDoRep1_1.Dd a) = GHC.Generics.D1
('GHC.Generics.MetaData
"Dd" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -187,16 +195,24 @@ GHC.Generics representation types:
"D1d"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11d")
- (GHC.Generics.Rec0 a)
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11d")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0 a)
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12d")
- (GHC.Generics.Rec0
- (CanDoRep1_1.Dd
- a))))
- type GHC.Generics.Rep (CanDoRep1_1.Dc a) = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12d")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0
+ (CanDoRep1_1.Dd
+ a))))
+ type GHC.Generics.Rep (CanDoRep1_1.Dc a) = GHC.Generics.D1
('GHC.Generics.MetaData
"Dc" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -208,16 +224,24 @@ GHC.Generics representation types:
"D1c"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11c")
- (GHC.Generics.Rec0 a)
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11c")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0 a)
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12c")
- (GHC.Generics.Rec0
- (CanDoRep1_1.Dc
- a))))
- type GHC.Generics.Rep1 CanDoRep1_1.Db = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12c")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0
+ (CanDoRep1_1.Dc
+ a))))
+ type GHC.Generics.Rep1 CanDoRep1_1.Db = GHC.Generics.D1
('GHC.Generics.MetaData
"Db" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -229,15 +253,23 @@ GHC.Generics representation types:
"D1b"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11b")
- GHC.Generics.Par1
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11b")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ GHC.Generics.Par1
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12b")
- (GHC.Generics.Rec1
- CanDoRep1_1.Db)))
- type GHC.Generics.Rep (CanDoRep1_1.Da a) = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12b")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec1
+ CanDoRep1_1.Db)))
+ type GHC.Generics.Rep (CanDoRep1_1.Da a) = GHC.Generics.D1
('GHC.Generics.MetaData
"Da" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -249,16 +281,24 @@ GHC.Generics representation types:
"D1"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11a")
- (GHC.Generics.Rec0 a)
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11a")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0 a)
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12a")
- (GHC.Generics.Rec0
- (CanDoRep1_1.Da
- a))))
- type GHC.Generics.Rep1 CanDoRep1_1.Da = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12a")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0
+ (CanDoRep1_1.Da
+ a))))
+ type GHC.Generics.Rep1 CanDoRep1_1.Da = GHC.Generics.D1
('GHC.Generics.MetaData
"Da" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -270,15 +310,23 @@ GHC.Generics representation types:
"D1"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11a")
- GHC.Generics.Par1
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11a")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ GHC.Generics.Par1
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12a")
- (GHC.Generics.Rec1
- CanDoRep1_1.Da)))
- type GHC.Generics.Rep (CanDoRep1_1.Db a) = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12a")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec1
+ CanDoRep1_1.Da)))
+ type GHC.Generics.Rep (CanDoRep1_1.Db a) = GHC.Generics.D1
('GHC.Generics.MetaData
"Db" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -290,16 +338,24 @@ GHC.Generics representation types:
"D1b"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11b")
- (GHC.Generics.Rec0 a)
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11b")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0 a)
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12b")
- (GHC.Generics.Rec0
- (CanDoRep1_1.Db
- a))))
- type GHC.Generics.Rep1 CanDoRep1_1.Dc = GHC.Generics.D1
+ ('GHC.Base.Just
+ "d12b")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec0
+ (CanDoRep1_1.Db
+ a))))
+ type GHC.Generics.Rep1 CanDoRep1_1.Dc = GHC.Generics.D1
('GHC.Generics.MetaData
"Dc" "CanDoRep1_1" "main" 'GHC.Types.False)
(GHC.Generics.C1
@@ -311,13 +367,21 @@ GHC.Generics representation types:
"D1c"
'GHC.Generics.PrefixI
'GHC.Types.True)
- (GHC.Generics.S1
- ('GHC.Generics.MetaSel "d11c")
- GHC.Generics.Par1
- GHC.Generics.:*: GHC.Generics.S1
+ (GHC.Generics.S1
+ ('GHC.Generics.MetaSel
+ ('GHC.Base.Just "d11c")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ GHC.Generics.Par1
+ GHC.Generics.:*: GHC.Generics.S1
('GHC.Generics.MetaSel
- "d12c")
- (GHC.Generics.Rec1
- CanDoRep1_1.Dc)))
+ ('GHC.Base.Just
+ "d12c")
+ 'GHC.Generics.NoSourceUnpackedness
+ 'GHC.Generics.NoSourceStrictness
+ 'GHC.Generics.DecidedLazy)
+ (GHC.Generics.Rec1
+ CanDoRep1_1.Dc)))
diff --git a/testsuite/tests/generics/all.T b/testsuite/tests/generics/all.T
index cbf70cf8bf..32534834f2 100644
--- a/testsuite/tests/generics/all.T
+++ b/testsuite/tests/generics/all.T
@@ -17,6 +17,8 @@ test('GenCannotDoRep1_6', normal, compile_fail, [''])
test('GenCannotDoRep1_7', normal, compile_fail, [''])
test('GenCannotDoRep1_8', normal, compile_fail, [''])
+test('GFullyStrict', normal, compile_and_run, [''])
+
test('T5462Yes1', outputdir('out_T5462Yes1')
, multimod_compile_and_run, ['T5462Yes1', '-iGEq -iGEnum -iGFunctor'])
test('T5462Yes2', outputdir('out_T5462Yes2')
View Lorry Controller Status