Commit 34d8bc24 authored by sheaf's avatar sheaf Committed by Marge Bot
Browse files

Fix parsing & printing of unboxed sums

The pretty-printing of partially applied unboxed sums was incorrect,
as we incorrectly dropped the first half of the arguments, even
for a partial application such as

  (# | #) @IntRep @DoubleRep Int#

which lead to the nonsensical (# DoubleRep | Int# #).

This patch also allows users to write unboxed sum type constructors
such as

  (# | #) :: TYPE r1 -> TYPE r2 -> TYPE (SumRep '[r1,r2]).

Fixes #20858 and #20859.
parent addf8e54
Pipeline #46024 canceled with stages
in 26 seconds
......@@ -202,7 +202,7 @@ import GHC.Utils.Panic.Plain
import qualified Data.ByteString.Char8 as BS
import Data.List ( elemIndex )
import Data.List ( elemIndex, intersperse )
alpha_tyvar :: [TyVar]
alpha_tyvar = [alphaTyVar]
......@@ -918,23 +918,31 @@ isBuiltInOcc_maybe occ =
-- unboxed sum tycon
_ | Just rest <- "(#" `BS.stripPrefix` name
, (pipes, rest') <- BS.span (=='|') rest
, (nb_pipes, rest') <- span_pipes rest
, "#)" <- rest'
-> Just $ tyConName $ sumTyCon (1+BS.length pipes)
-> Just $ tyConName $ sumTyCon (1+nb_pipes)
-- unboxed sum datacon
_ | Just rest <- "(#" `BS.stripPrefix` name
, (pipes1, rest') <- BS.span (=='|') rest
, (nb_pipes1, rest') <- span_pipes rest
, Just rest'' <- "_" `BS.stripPrefix` rest'
, (pipes2, rest''') <- BS.span (=='|') rest''
, (nb_pipes2, rest''') <- span_pipes rest''
, "#)" <- rest'''
-> let arity = BS.length pipes1 + BS.length pipes2 + 1
alt = BS.length pipes1 + 1
-> let arity = nb_pipes1 + nb_pipes2 + 1
alt = nb_pipes1 + 1
in Just $ dataConName $ sumDataCon alt arity
_ -> Nothing
where
name = bytesFS $ occNameFS occ
span_pipes :: BS.ByteString -> (Int, BS.ByteString)
span_pipes = go 0
where
go nb_pipes bs = case BS.uncons bs of
Just ('|',rest) -> go (nb_pipes + 1) rest
Just (' ',rest) -> go nb_pipes rest
_ -> (nb_pipes, bs)
choose_ns :: Name -> Name -> Name
choose_ns tc dc
| isTcClsNameSpace ns = tc
......@@ -1236,16 +1244,16 @@ mkSumTyConOcc :: Arity -> OccName
mkSumTyConOcc n = mkOccName tcName str
where
-- No need to cache these, the caching is done in mk_sum
str = '(' : '#' : bars ++ "#)"
bars = replicate (n-1) '|'
str = '(' : '#' : ' ' : bars ++ " #)"
bars = intersperse ' ' $ replicate (n-1) '|'
-- | OccName for i-th alternative of n-ary unboxed sum data constructor.
mkSumDataConOcc :: ConTag -> Arity -> OccName
mkSumDataConOcc alt n = mkOccName dataName str
where
-- No need to cache these, the caching is done in mk_sum
str = '(' : '#' : bars alt ++ '_' : bars (n - alt - 1) ++ "#)"
bars i = replicate i '|'
str = '(' : '#' : ' ' : bars alt ++ '_' : bars (n - alt - 1) ++ " #)"
bars i = intersperse ' ' $ replicate i '|'
-- | Type constructor for n-ary unboxed sum.
sumTyCon :: Arity -> TyCon
......
......@@ -3851,6 +3851,10 @@ impliedXFlags
, (LangExt.TemplateHaskell, turnOn, LangExt.TemplateHaskellQuotes)
, (LangExt.Strict, turnOn, LangExt.StrictData)
-- Historically only UnboxedTuples was required for unboxed sums to work.
-- To avoid breaking code, we make UnboxedTuples imply UnboxedSums.
, (LangExt.UnboxedTuples, turnOn, LangExt.UnboxedSums)
-- The extensions needed to declare an H98 unlifted data type
, (LangExt.UnliftedDatatypes, turnOn, LangExt.DataKinds)
, (LangExt.UnliftedDatatypes, turnOn, LangExt.StandaloneKindSignatures)
......
......@@ -251,13 +251,13 @@ data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
| IfaceTupleTyCon !Arity !TupleSort
-- ^ e.g. @(a, b, c)@ or @(#a, b, c#)@.
-- ^ a tuple, e.g. @(a, b, c)@ or @(#a, b, c#)@.
-- The arity is the tuple width, not the tycon arity
-- (which is twice the width in the case of unboxed
-- tuples).
| IfaceSumTyCon !Arity
-- ^ e.g. @(a | b | c)@
-- ^ an unboxed sum, e.g. @(# a | b | c #)@
| IfaceEqualityTyCon
-- ^ A heterogeneous equality TyCon
......@@ -928,7 +928,7 @@ ppr_ty ctxt_prec ty@(IfaceFunTy InvisArg _ _ _) = ppr_sigma ctxt_prec ty
ppr_ty _ (IfaceFreeTyVar tyvar) = ppr tyvar -- This is the main reason for IfaceFreeTyVar!
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar -- See Note [Free tyvars in IfaceType]
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys
ppr_ty ctxt_prec (IfaceTupleTy i p tys) = pprTuple ctxt_prec i p tys -- always fully saturated
ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
-- Function types
ppr_ty ctxt_prec (IfaceFunTy _ w ty1 ty2) -- Should be VisArg
......@@ -1461,9 +1461,13 @@ pprTyTcApp ctxt_prec tc tys =
, not debug
, arity == ifaceVisAppArgsLength tys
-> pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys
-- NB: pprTuple requires a saturated tuple.
| IfaceSumTyCon arity <- ifaceTyConSort info
-> pprSum arity (ifaceTyConIsPromoted info) tys
, not debug
, arity == ifaceVisAppArgsLength tys
-> pprSum (ifaceTyConIsPromoted info) tys
-- NB: pprSum requires a saturated unboxed sum.
| tc `ifaceTyConHasKey` consDataConKey
, False <- print_kinds
......@@ -1627,8 +1631,13 @@ ppr_iface_tc_app pp ctxt_prec tc tys
| otherwise
= pprIfacePrefixApp ctxt_prec (parens (ppr tc)) (map (pp appPrec) tys)
pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum _arity is_promoted args
-- | Pretty-print an unboxed sum type. The sum should be saturated:
-- as many visible arguments as the arity of the sum.
--
-- NB: this always strips off the invisible 'RuntimeRep' arguments,
-- even with `-fprint-explicit-runtime-reps` and `-fprint-explicit-kinds`.
pprSum :: PromotionFlag -> IfaceAppArgs -> SDoc
pprSum is_promoted args
= -- drop the RuntimeRep vars.
-- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
let tys = appArgsIfaceTypes args
......@@ -1636,6 +1645,12 @@ pprSum _arity is_promoted args
in pprPromotionQuoteI is_promoted
<> sumParens (pprWithBars (ppr_ty topPrec) args')
-- | Pretty-print a tuple type (boxed tuple, constraint tuple, unboxed tuple).
-- The tuple should be saturated: as many visible arguments as the arity of
-- the tuple.
--
-- NB: this always strips off the invisible 'RuntimeRep' arguments,
-- even with `-fprint-explicit-runtime-reps` and `-fprint-explicit-kinds`.
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple ctxt_prec sort promoted args =
case promoted of
......
......@@ -92,7 +92,8 @@ import GHC.Parser.Annotation
import GHC.Parser.Errors.Types
import GHC.Parser.Errors.Ppr ()
import GHC.Builtin.Types ( unitTyCon, unitDataCon, tupleTyCon, tupleDataCon, nilDataCon,
import GHC.Builtin.Types ( unitTyCon, unitDataCon, sumTyCon,
tupleTyCon, tupleDataCon, nilDataCon,
unboxedUnitTyCon, unboxedUnitDataCon,
listTyCon_RDR, consDataCon_RDR, eqTyCon_RDR)
......@@ -3043,11 +3044,13 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
; return (Tuple (cos ++ $2)) } }
| texp bars { unECP $1 >>= \ $1 -> return $
(Sum 1 (snd $2 + 1) $1 [] (fst $2)) }
(Sum 1 (snd $2 + 1) $1 [] (map (EpaSpan . realSrcSpan) $ fst $2)) }
| bars texp bars0
{ unECP $2 >>= \ $2 -> return $
(Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2 (fst $1) (fst $3)) }
(Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2
(map (EpaSpan . realSrcSpan) $ fst $1)
(map (EpaSpan . realSrcSpan) $ fst $3)) }
-- Always starts with commas; always follows an expr
commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn EpaLocation) (LocatedA b)]) }
......@@ -3571,6 +3574,8 @@ ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit
| '(#' commas '#)' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Unboxed
(snd $2 + 1)))
(NameAnnCommas NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
| '(#' bars '#)' {% amsrn (sLL $1 $> $ getRdrName (sumTyCon (snd $2 + 1)))
(NameAnnBars NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) }
| '(' '->' ')' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
(NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) }
| '[' ']' {% amsrn (sLL $1 $> $ listTyCon_RDR)
......@@ -3862,13 +3867,13 @@ commas :: { ([SrcSpan],Int) } -- One or more commas
: commas ',' { ((fst $1)++[gl $2],snd $1 + 1) }
| ',' { ([gl $1],1) }
bars0 :: { ([EpaLocation],Int) } -- Zero or more bars
bars0 :: { ([SrcSpan],Int) } -- Zero or more bars
: bars { $1 }
| { ([], 0) }
bars :: { ([EpaLocation],Int) } -- One or more bars
: bars '|' { ((fst $1)++[glAA $2],snd $1 + 1) }
| '|' { ([glAA $1],1) }
bars :: { ([SrcSpan],Int) } -- One or more bars
: bars '|' { ((fst $1)++[gl $2],snd $1 + 1) }
| '|' { ([gl $1],1) }
{
happyError :: P a
......
......@@ -736,6 +736,14 @@ data NameAnn
nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @(# | | #)@
| NameAnnBars {
nann_adornment :: NameAdornment,
nann_open :: EpaLocation,
nann_bars :: [EpaLocation],
nann_close :: EpaLocation,
nann_trailing :: [TrailingAnn]
}
-- | Used for @()@, @(##)@, @[]@
| NameAnnOnly {
nann_adornment :: NameAdornment,
......@@ -1274,6 +1282,8 @@ instance Outputable NameAnn where
= text "NameAnn" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
ppr (NameAnnCommas a o n c t)
= text "NameAnnCommas" <+> ppr a <+> ppr o <+> ppr n <+> ppr c <+> ppr t
ppr (NameAnnBars a o n b t)
= text "NameAnnBars" <+> ppr a <+> ppr o <+> ppr n <+> ppr b <+> ppr t
ppr (NameAnnOnly a o c t)
= text "NameAnnOnly" <+> ppr a <+> ppr o <+> ppr c <+> ppr t
ppr (NameAnnRArrow n t)
......
......@@ -444,11 +444,9 @@ $tab { warnTab }
}
<0> {
"(#" / { ifExtension UnboxedTuplesBit `alexOrPred`
ifExtension UnboxedSumsBit }
"(#" / { ifExtension UnboxedParensBit }
{ token IToubxparen }
"#)" / { ifExtension UnboxedTuplesBit `alexOrPred`
ifExtension UnboxedSumsBit }
"#)" / { ifExtension UnboxedParensBit }
{ token ITcubxparen }
}
......@@ -2732,8 +2730,7 @@ data ExtBits
| RecursiveDoBit -- mdo
| QualifiedDoBit -- .do and .mdo
| UnicodeSyntaxBit -- the forall symbol, arrow symbols, etc
| UnboxedTuplesBit -- (# and #)
| UnboxedSumsBit -- (# and #)
| UnboxedParensBit -- (# and #)
| DatatypeContextsBit
| MonadComprehensionsBit
| TransformComprehensionsBit
......@@ -2814,8 +2811,7 @@ mkParserOpts extensionFlags diag_opts supported
.|. RecursiveDoBit `xoptBit` LangExt.RecursiveDo
.|. QualifiedDoBit `xoptBit` LangExt.QualifiedDo
.|. UnicodeSyntaxBit `xoptBit` LangExt.UnicodeSyntax
.|. UnboxedTuplesBit `xoptBit` LangExt.UnboxedTuples
.|. UnboxedSumsBit `xoptBit` LangExt.UnboxedSums
.|. UnboxedParensBit `orXoptsBit` [LangExt.UnboxedTuples, LangExt.UnboxedSums]
.|. DatatypeContextsBit `xoptBit` LangExt.DatatypeContexts
.|. TransformComprehensionsBit `xoptBit` LangExt.TransformListComp
.|. MonadComprehensionsBit `xoptBit` LangExt.MonadComprehensions
......@@ -2851,6 +2847,8 @@ mkParserOpts extensionFlags diag_opts supported
xoptBit bit ext = bit `setBitIf` EnumSet.member ext extensionFlags
xoptNotBit bit ext = bit `setBitIf` not (EnumSet.member ext extensionFlags)
orXoptsBit bit exts = bit `setBitIf` any (`EnumSet.member` extensionFlags) exts
setBitIf :: ExtBits -> Bool -> ExtsBitmap
b `setBitIf` cond | cond = xbit b
| otherwise = 0
......
......@@ -25,6 +25,7 @@ import GHC.Data.Bag
import GHC.Tc.Errors.Types
import GHC.Tc.Types.Rank (Rank(..))
import GHC.Tc.Utils.TcType (TcType, tcSplitForAllTyVars, mkClassPred)
import GHC.Types.Basic (UnboxedTupleOrSum(..), unboxedTupleOrSumExtension)
import GHC.Types.Error
import GHC.Types.FieldLabel (FieldLabelString, flIsOverloaded, flSelector)
import GHC.Types.Id (isRecordSelector)
......@@ -201,10 +202,14 @@ instance Diagnostic TcRnMessage where
TcRnConstraintInKind ty
-> mkSimpleDecorated $
text "Illegal constraint in a kind:" <+> pprType ty
TcRnUnboxedTupleTypeFuncArg ty
TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum ty
-> mkSimpleDecorated $
sep [ text "Illegal unboxed tuple type as function argument:"
sep [ text "Illegal unboxed" <+> what <+> text "type as function argument:"
, pprType ty ]
where
what = case tuple_or_sum of
UnboxedTupleType -> text "tuple"
UnboxedSumType -> text "sum"
TcRnLinearFuncInKind ty
-> mkSimpleDecorated $
text "Illegal linear function in a kind:" <+> pprType ty
......@@ -630,7 +635,7 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnConstraintInKind{}
-> ErrorWithoutFlag
TcRnUnboxedTupleTypeFuncArg{}
TcRnUnboxedTupleOrSumTypeFuncArg{}
-> ErrorWithoutFlag
TcRnLinearFuncInKind{}
-> ErrorWithoutFlag
......@@ -852,8 +857,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnConstraintInKind{}
-> noHints
TcRnUnboxedTupleTypeFuncArg{}
-> [suggestExtension LangExt.UnboxedTuples]
TcRnUnboxedTupleOrSumTypeFuncArg tuple_or_sum _
-> [suggestExtension $ unboxedTupleOrSumExtension tuple_or_sum]
TcRnLinearFuncInKind{}
-> noHints
TcRnForAllEscapeError{}
......
......@@ -635,8 +635,9 @@ data TcRnMessage where
-}
TcRnConstraintInKind :: !Type -> TcRnMessage
{-| TcRnUnboxedTupleTypeFuncArg is an error that occurs whenever an unboxed tuple type
is specified as a function argument.
{-| TcRnUnboxedTupleTypeFuncArg is an error that occurs whenever an unboxed tuple
or unboxed sum type is specified as a function argument, when the appropriate
extension (`-XUnboxedTuples` or `-XUnboxedSums`) isn't enabled.
Examples(s):
-- T15073.hs
......@@ -652,7 +653,10 @@ data TcRnMessage where
deriving/should_fail/T15073a.hs
typecheck/should_fail/T16059d
-}
TcRnUnboxedTupleTypeFuncArg :: !Type -> TcRnMessage
TcRnUnboxedTupleOrSumTypeFuncArg
:: UnboxedTupleOrSum -- ^ whether this is an unboxed tuple or an unboxed sum
-> !Type
-> TcRnMessage
{-| TcRnLinearFuncInKind is an error that occurs whenever a linear function is
specified in a kind.
......
......@@ -56,6 +56,7 @@ import GHC.Tc.Instance.FunDeps
import GHC.Core.FamInstEnv
( isDominatedBy, injectiveBranches, InjectivityCheckResult(..) )
import GHC.Tc.Instance.Family
import GHC.Types.Basic ( UnboxedTupleOrSum(..), unboxedTupleOrSumExtension )
import GHC.Types.Name
import GHC.Types.Var.Env
import GHC.Types.Var.Set
......@@ -693,8 +694,14 @@ check_type ve (AppTy ty1 ty2)
check_type ve ty@(TyConApp tc tys)
| isTypeSynonymTyCon tc || isTypeFamilyTyCon tc
= check_syn_tc_app ve ty tc tys
-- Check for unboxed tuples and unboxed sums: these
-- require the corresponding extension to be enabled.
| isUnboxedTupleTyCon tc
= check_ubx_tuple ve ty tys
= check_ubx_tuple_or_sum UnboxedTupleType ve ty tys
| isUnboxedSumTyCon tc
= check_ubx_tuple_or_sum UnboxedSumType ve ty tys
| otherwise
= mapM_ (check_arg_type False ve) tys
......@@ -838,16 +845,17 @@ field to False.
-}
----------------------------------------
check_ubx_tuple :: ValidityEnv -> KindOrType -> [KindOrType] -> TcM ()
check_ubx_tuple (ve@ValidityEnv{ve_tidy_env = env}) ty tys
= do { ub_tuples_allowed <- xoptM LangExt.UnboxedTuples
; checkTcM ub_tuples_allowed (env, TcRnUnboxedTupleTypeFuncArg (tidyType env ty))
check_ubx_tuple_or_sum :: UnboxedTupleOrSum -> ValidityEnv -> KindOrType -> [KindOrType] -> TcM ()
check_ubx_tuple_or_sum tup_or_sum (ve@ValidityEnv{ve_tidy_env = env}) ty tys
= do { ub_thing_allowed <- xoptM $ unboxedTupleOrSumExtension tup_or_sum
; checkTcM ub_thing_allowed
(env, TcRnUnboxedTupleOrSumTypeFuncArg tup_or_sum (tidyType env ty))
; impred <- xoptM LangExt.ImpredicativeTypes
; let rank' = if impred then ArbitraryRank else MonoTypeTyConArg
-- c.f. check_arg_type
-- However, args are allowed to be unlifted, or
-- more unboxed tuples, so can't use check_arg_ty
-- more unboxed tuples or sums, so can't use check_arg_ty
; mapM_ (check_type (ve{ve_rank = rank'})) tys }
----------------------------------------
......
......@@ -51,6 +51,7 @@ module GHC.Types.Basic (
TupleSort(..), tupleSortBoxity, boxityTupleSort,
tupleParens,
UnboxedTupleOrSum(..), unboxedTupleOrSumExtension,
sumParens, pprAlternative,
-- ** The OneShotInfo type
......@@ -115,6 +116,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Binary
import GHC.Types.SourceText
import qualified GHC.LanguageExtensions as LangExt
import Data.Data
import qualified Data.Semigroup as Semi
......@@ -878,6 +880,22 @@ pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use
pprAlternative pp x alt arity =
fsep (replicate (alt - 1) vbar ++ [pp x] ++ replicate (arity - alt) vbar)
-- | Are we dealing with an unboxed tuple or an unboxed sum?
--
-- Used when validity checking, see 'check_ubx_tuple_or_sum'.
data UnboxedTupleOrSum
= UnboxedTupleType
| UnboxedSumType
deriving Eq
instance Outputable UnboxedTupleOrSum where
ppr UnboxedTupleType = text "UnboxedTupleType"
ppr UnboxedSumType = text "UnboxedSumType"
unboxedTupleOrSumExtension :: UnboxedTupleOrSum -> LangExt.Extension
unboxedTupleOrSumExtension UnboxedTupleType = LangExt.UnboxedTuples
unboxedTupleOrSumExtension UnboxedSumType = LangExt.UnboxedSums
{-
************************************************************************
* *
......
......@@ -1635,7 +1635,6 @@ data HsBracket p
| TypBr (XTypBr p) (LHsType p) -- [t| type |]
| VarBr (XVarBr p) Bool (LIdP p)
-- True: 'x, False: ''T
-- (The Bool flag is used only in pprHsBracket)
| TExpBr (XTExpBr p) (LHsExpr p) -- [|| expr ||]
| XBracket !(XXBracket p) -- Extension point; see Note [Trees That Grow]
-- in Language.Haskell.Syntax.Extension
......
......@@ -25,6 +25,19 @@ Compiler
parameters with such kinds are unlikely to be very useful, due to
:ghc-ticket:`18759`.
- Changes to the treatment of :extension:`UnboxedSums`:
- GHC can now parse unboxed sum type constructors ``(# | #)``, ``(# | | #)``,
``(# | | | #)`, etc. Partial applications need to be written in prefix form,
e.g. ``(# | #) Int#``.
- Unboxed sums now require the :extension:`UnboxedSums` extension to be enabled.
- The :extension:`UnboxedTuples` extension now implies
:extension:`UnboxedSums`. This means that code using unboxed sums that
enabled the :extension:`UnboxedTuples` extension but didn't explicitly
enable :extension:`UnboxedSums` will continue to work without changes.
``base`` library
~~~~~~~~~~~~~~~~
......
......@@ -147,6 +147,8 @@ Unboxed tuples
.. extension:: UnboxedTuples
:shortdesc: Enable the use of unboxed tuple syntax.
:implies: :extension:`UnboxedSums`
:since: 6.8.1
......@@ -200,6 +202,10 @@ example desugars like this:
Indeed, the bindings can even be recursive.
To refer to the unboxed tuple type constructors themselves, e.g. if you
want to attach instances to them, use ``(# #)``, ``(#,#)``, ``(#,,#)``, etc.
This mirrors the syntax for boxed tuples ``()``, ``(,)``, ``(,,)``, etc.
.. _unboxed-sums:
Unboxed sums
......@@ -211,6 +217,7 @@ Unboxed sums
:since: 8.2.1
Enable the use of unboxed sum syntax.
Implied by :extension:`UnboxedTuples`.
`-XUnboxedSums` enables new syntax for anonymous, unboxed sum types. The syntax
for an unboxed sum type with N alternatives is ::
......@@ -237,6 +244,14 @@ The pattern syntax reflects the term syntax: ::
(# (# i, str #) | #) -> ...
(# | bool #) -> ...
Note that spaces are always required around bars. For example, ``(# | 1# | | #)``
is valid, but ``(# | 1# || #)`` and ``(#| 1# | | #)`` are both invalid.
The type constructors themselves can be written in prefix form as ``(# | #)``,
``(# | | #)``, ``(# | | | #)``, etc. Partial applications must also use prefix form,
i.e. ``(# | #) Int#``. Saturated applications can be written either way,
so that ``(# | #) Int# Float#`` is equivalent to ``(# Int# | Float# #)``.
Unboxed sums are "unboxed" in the sense that, instead of allocating sums in the
heap and representing values as pointers, unboxed sums are represented as their
components, just like unboxed tuples. These "components" depend on alternatives
......
T15067.hs:9:14: error:
• No instance for (Typeable (# GHC.Types.LiftedRep #))
• No instance for (Typeable (# | #))
arising from a use of ‘typeRep’
GHC can't yet do polykinded
Typeable ((# GHC.Types.LiftedRep #) :: *
-> *
-> TYPE
('GHC.Types.SumRep
'[GHC.Types.LiftedRep,
GHC.Types.LiftedRep]))
Typeable ((# | #) :: *
-> *
-> TYPE
('GHC.Types.SumRep '[GHC.Types.LiftedRep, GHC.Types.LiftedRep]))
• In the expression: typeRep
In an equation for ‘floopadoop’: floopadoop = typeRep
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedSums #-}
module T20858 where
import Data.Kind
( Type )
import GHC.Exts
( Double#, Int#, Word# )
type GetFunKind :: k -> Type
type family GetFunKind x where
forall arg_k res_k (a :: arg_k -> res_k) (b :: arg_k). GetFunKind (a b) = arg_k -> res_k
type GetFun :: forall res_k. forall (x :: res_k) -> GetFunKind x
type family GetFun x where
GetFun (a b) = a
type S1 = GetFun (# Int# | Double# | Word# #)
type S2 = GetFun S1
type S3 = GetFun S2
:seti -XUnboxedSums
:l T20858
:kind! S1
:kind! S2
:kind! S3
S1 :: TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
'[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
= (# | | #) Int# Double#
S2 :: TYPE 'GHC.Types.DoubleRep
-> TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
'[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
= (# | | #) Int#
S3 :: TYPE 'GHC.Types.IntRep
-> TYPE 'GHC.Types.DoubleRep
-> TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
'[ 'GHC.Types.IntRep, 'GHC.Types.DoubleRep, 'GHC.Types.WordRep])
= (# | | #)
:seti -XUnboxedSums
:l T20858
:kind! S1
:kind! S2
:kind! S3
S1 :: TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.IntRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.DoubleRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.WordRep
('[] @GHC.Types.RuntimeRep)))))
= (# | | #)
@'GHC.Types.IntRep
@'GHC.Types.DoubleRep
@'GHC.Types.WordRep
Int#
Double#
S2 :: TYPE 'GHC.Types.DoubleRep
-> TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.IntRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.DoubleRep
((':)
@GHC.Types.RuntimeRep
'GHC.Types.WordRep
('[] @GHC.Types.RuntimeRep)))))
= (# | | #)
@'GHC.Types.IntRep @'GHC.Types.DoubleRep @'GHC.Types.WordRep Int#
S3 :: TYPE 'GHC.Types.IntRep
-> TYPE 'GHC.Types.DoubleRep
-> TYPE 'GHC.Types.WordRep
-> TYPE
('GHC.Types.SumRep
((':)
@GHC.Types.RuntimeRep