Commit 613d7455 authored by Ryan Scott's avatar Ryan Scott Committed by Ben Gamari

Template Haskell support for unboxed sums

This adds new constructors `UnboxedSumE`, `UnboxedSumT`, and
`UnboxedSumP` to represent unboxed sums in Template Haskell.

One thing you can't currently do is, e.g., `reify ''(#||#)`, since I
don't believe unboxed sum type/data constructors can be written in
prefix form.  I will look at fixing that as part of #12514.

Fixes #12478.

Test Plan: make test TEST=T12478_{1,2,3}

Reviewers: osa1, goldfire, austin, bgamari

Reviewed By: goldfire, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2448

GHC Trac Issues: #12478
parent 1766bb3c
......@@ -977,6 +977,9 @@ repTy (HsTupleTy HsUnboxedTuple tys) = do
repTy (HsTupleTy _ tys) = do tys1 <- repLTys tys
tcon <- repTupleTyCon (length tys)
repTapps tcon tys1
repTy (HsSumTy tys) = do tys1 <- repLTys tys
tcon <- repUnboxedSumTyCon (length tys)
repTapps tcon tys1
repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
`nlHsAppTy` ty2)
repTy (HsParTy t) = repLTy t
......@@ -1176,6 +1179,10 @@ repE e@(ExplicitTuple es boxed)
| otherwise = do { xs <- repLEs [e | L _ (Present e) <- es]
; repUnboxedTup xs }
repE (ExplicitSum alt arity e _)
= do { e1 <- repLE e
; repUnboxedSum e1 alt arity }
repE (RecordCon { rcon_con_name = c, rcon_flds = flds })
= do { x <- lookupLOcc c;
fs <- repFields flds;
......@@ -1584,6 +1591,7 @@ repP (ListPat ps ty1 (Just (_,e))) = do { p <- repP (ListPat ps ty1 Nothing); e'
repP (TuplePat ps boxed _)
| isBoxed boxed = do { qs <- repLPs ps; repPtup qs }
| otherwise = do { qs <- repLPs ps; repPunboxedTup qs }
repP (SumPat p alt arity _) = do { p1 <- repLP p; repPunboxedSum p1 alt arity }
repP (ConPatIn dc details)
= do { con_str <- lookupLOcc dc
; case details of
......@@ -1793,6 +1801,14 @@ repPtup (MkC ps) = rep2 tupPName [ps]
repPunboxedTup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
repPunboxedTup (MkC ps) = rep2 unboxedTupPName [ps]
repPunboxedSum :: Core TH.PatQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.PatQ)
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repPunboxedSum (MkC p) alt arity
= do { dflags <- getDynFlags
; rep2 unboxedSumPName [ p
, mkIntExprInt dflags alt
, mkIntExprInt dflags arity ] }
repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
......@@ -1849,6 +1865,14 @@ repTup (MkC es) = rep2 tupEName [es]
repUnboxedTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
repUnboxedTup (MkC es) = rep2 unboxedTupEName [es]
repUnboxedSum :: Core TH.ExpQ -> TH.SumAlt -> TH.SumArity -> DsM (Core TH.ExpQ)
-- Note: not Core TH.SumAlt or Core TH.SumArity; it's easier to be direct here
repUnboxedSum (MkC e) alt arity
= do { dflags <- getDynFlags
; rep2 unboxedSumEName [ e
, mkIntExprInt dflags alt
, mkIntExprInt dflags arity ] }
repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
......@@ -2185,6 +2209,11 @@ repUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
repUnboxedTupleTyCon i = do dflags <- getDynFlags
rep2 unboxedTupleTName [mkIntExprInt dflags i]
repUnboxedSumTyCon :: TH.SumArity -> DsM (Core TH.TypeQ)
-- Note: not Core TH.SumArity; it's easier to be direct here
repUnboxedSumTyCon arity = do dflags <- getDynFlags
rep2 unboxedSumTName [mkIntExprInt dflags arity]
repArrowTyCon :: DsM (Core TH.TypeQ)
repArrowTyCon = rep2 arrowTName []
......
......@@ -771,6 +771,10 @@ cvtl e = wrapL (cvt e)
cvt (UnboxedTupE es) = do { es' <- mapM cvtl es
; return $ ExplicitTuple
(map (noLoc . Present) es') Unboxed }
cvt (UnboxedSumE e alt arity) = do { e' <- cvtl e
; unboxedSumChecks alt arity
; return $ ExplicitSum
alt arity e' placeHolderType }
cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z;
; return $ HsIf (Just noSyntaxExpr) x' y' z' }
cvt (MultiIfE alts)
......@@ -1045,6 +1049,10 @@ cvtp (TH.VarP s) = do { s' <- vName s; return $ Hs.VarPat (noLoc s') }
cvtp (TupP [p]) = do { p' <- cvtPat p; return $ ParPat p' } -- Note [Dropping constructors]
cvtp (TupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed [] }
cvtp (UnboxedTupP ps) = do { ps' <- cvtPats ps; return $ TuplePat ps' Unboxed [] }
cvtp (UnboxedSumP p alt arity)
= do { p' <- cvtPat p
; unboxedSumChecks alt arity
; return $ SumPat p' alt arity placeHolderType }
cvtp (ConP s ps) = do { s' <- cNameL s; ps' <- cvtPats ps
; return $ ConPatIn s' (PrefixCon ps') }
cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
......@@ -1138,6 +1146,16 @@ cvtTypeKind ty_str ty
| otherwise
-> mk_apps (HsTyVar (noLoc (getRdrName (tupleTyCon Unboxed n))))
tys'
UnboxedSumT n
| n < 2
-> failWith $
vcat [ text "Illegal sum arity:" <+> text (show n)
, nest 2 $
text "Sums must have an arity of at least 2" ]
| length tys' == n -- Saturated
-> returnL (HsSumTy tys')
| otherwise
-> mk_apps (HsTyVar (noLoc (getRdrName (sumTyCon n)))) tys'
ArrowT
| [x',y'] <- tys' -> returnL (HsFunTy x' y')
| otherwise -> mk_apps (HsTyVar (noLoc (getRdrName funTyCon))) tys'
......@@ -1348,6 +1366,22 @@ overloadedLit _ = False
cvtFractionalLit :: Rational -> FractionalLit
cvtFractionalLit r = FL { fl_text = show (fromRational r :: Double), fl_value = r }
-- Checks that are performed when converting unboxed sum expressions and
-- patterns alike.
unboxedSumChecks :: TH.SumAlt -> TH.SumArity -> CvtM ()
unboxedSumChecks alt arity
| alt > arity
= failWith $ text "Sum alternative" <+> text (show alt)
<+> text "exceeds its arity," <+> text (show arity)
| alt <= 0
= failWith $ vcat [ text "Illegal sum alternative:" <+> text (show alt)
, nest 2 $ text "Sum alternatives must start from 1" ]
| arity < 2
= failWith $ vcat [ text "Illegal sum arity:" <+> text (show arity)
, nest 2 $ text "Sums must have an arity of at least 2" ]
| otherwise
= return ()
--------------------------------------------------------------------
-- Turning Name back into RdrName
--------------------------------------------------------------------
......
This diff is collapsed.
......@@ -1819,7 +1819,8 @@ reify_tc_app tc tys
tc_binders = tyConBinders tc
tc_res_kind = tyConResKind tc
r_tc | isUnboxedTupleTyCon tc = TH.UnboxedTupleT (arity `div` 2)
r_tc | isUnboxedSumTyCon tc = TH.UnboxedSumT (arity `div` 2)
| isUnboxedTupleTyCon tc = TH.UnboxedTupleT (arity `div` 2)
-- See Note [Unboxed tuple RuntimeRep vars] in TyCon
| isTupleTyCon tc = if isPromotedDataCon tc
then TH.PromotedTupleT arity
......
......@@ -213,6 +213,8 @@ template-haskell
- Version number XXXXX (was 2.9.0.0)
- Added support for unboxed sums :ghc-ticket:`12478`.
time
~~~~
......
......@@ -24,6 +24,7 @@ module Language.Haskell.TH(
Info(..), ModuleInfo(..),
InstanceDec,
ParentName,
SumAlt, SumArity,
Arity,
Unlifted,
-- *** Language extension lookup
......@@ -95,7 +96,7 @@ module Language.Haskell.TH(
intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
charL, stringL, stringPrimL, charPrimL,
-- *** Patterns
litP, varP, tupP, conP, uInfixP, parensP, infixP,
litP, varP, tupP, unboxedSumP, conP, uInfixP, parensP, infixP,
tildeP, bangP, asP, wildP, recP,
listP, sigP, viewP,
fieldPat,
......@@ -106,8 +107,8 @@ module Language.Haskell.TH(
-- *** Expressions
dyn, varE, conE, litE, appE, uInfixE, parensE, staticE,
infixE, infixApp, sectionL, sectionR,
lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE,
listE, sigE, recConE, recUpdE, stringE, fieldExp,
lamE, lam1E, lamCaseE, tupE, unboxedSumE, condE, multiIfE, letE, caseE,
appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,
-- **** Ranges
fromE, fromThenE, fromToE, fromThenToE,
......@@ -120,8 +121,8 @@ module Language.Haskell.TH(
-- *** Types
forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,
listT, tupleT, sigT, litT, promotedT, promotedTupleT, promotedNilT,
promotedConsT,
listT, tupleT, unboxedSumT, sigT, litT, promotedT, promotedTupleT,
promotedNilT, promotedConsT,
-- **** Type literals
numTyLit, strTyLit,
-- **** Strictness
......
......@@ -80,12 +80,19 @@ rationalL = RationalL
litP :: Lit -> PatQ
litP l = return (LitP l)
varP :: Name -> PatQ
varP v = return (VarP v)
tupP :: [PatQ] -> PatQ
tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}
unboxedTupP :: [PatQ] -> PatQ
unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}
unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ
unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }
conP :: Name -> [PatQ] -> PatQ
conP n ps = do ps' <- sequence ps
return (ConP n ps')
......@@ -266,6 +273,9 @@ tupE es = do { es1 <- sequence es; return (TupE es1)}
unboxedTupE :: [ExpQ] -> ExpQ
unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ
unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }
condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)}
......@@ -627,6 +637,9 @@ tupleT i = return (TupleT i)
unboxedTupleT :: Int -> TypeQ
unboxedTupleT i = return (UnboxedTupleT i)
unboxedSumT :: SumArity -> TypeQ
unboxedSumT arity = return (UnboxedSumT arity)
sigT :: TypeQ -> Kind -> TypeQ
sigT t k
= do
......
......@@ -149,6 +149,7 @@ pprExp i (LamCaseE ms) = parensIf (i > noPrec)
$ text "\\case" $$ nest nestDepth (ppr ms)
pprExp _ (TupE es) = parens (commaSep es)
pprExp _ (UnboxedTupE es) = hashParens (commaSep es)
pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity
-- Nesting in Cond is to avoid potential problems in do statments
pprExp i (CondE guard true false)
= parensIf (i > noPrec) $ sep [text "if" <+> ppr guard,
......@@ -179,7 +180,7 @@ pprExp i (DoE ss_) = parensIf (i > noPrec) $ text "do" <+> pprStms ss_
pprExp _ (CompE []) = text "<<Empty CompExp>>"
-- This will probably break with fixity declarations - would need a ';'
pprExp _ (CompE ss) = text "[" <> ppr s
<+> text "|"
<+> bar
<+> commaSep ss'
<> text "]"
where s = last ss
......@@ -205,7 +206,7 @@ instance Ppr Stmt where
ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e
ppr (LetS ds) = text "let" <+> (braces (semiSep ds))
ppr (NoBindS e) = ppr e
ppr (ParS sss) = sep $ punctuate (text "|")
ppr (ParS sss) = sep $ punctuate bar
$ map commaSep sss
------------------------------
......@@ -216,8 +217,8 @@ instance Ppr Match where
------------------------------
pprGuarded :: Doc -> (Guard, Exp) -> Doc
pprGuarded eqDoc (guard, expr) = case guard of
NormalG guardExpr -> char '|' <+> ppr guardExpr <+> eqDoc <+> ppr expr
PatG stmts -> char '|' <+> vcat (punctuate comma $ map ppr stmts) $$
NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr
PatG stmts -> bar <+> vcat (punctuate comma $ map ppr stmts) $$
nest nestDepth (eqDoc <+> ppr expr)
------------------------------
......@@ -266,6 +267,7 @@ pprPat i (LitP l) = pprLit i l
pprPat _ (VarP v) = pprName' Applied v
pprPat _ (TupP ps) = parens (commaSep ps)
pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)
pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity
pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s
<+> sep (map (pprPat appPrec) ps)
pprPat _ (ParensP p) = parens $ pprPat noPrec p
......@@ -389,7 +391,7 @@ ppr_data maybeInst ctxt t argsDoc ksig cs decs
pref :: [Doc] -> [Doc]
pref xs | isGadtDecl = xs
pref [] = [] -- No constructors; can't happen in H98
pref (d:ds) = (char '=' <+> d):map (char '|' <+>) ds
pref (d:ds) = (char '=' <+> d):map (bar <+>) ds
maybeWhere :: Doc
maybeWhere | isGadtDecl = text "where"
......@@ -436,7 +438,7 @@ ppr_tf_head (TypeFamilyHead tc tvs res inj)
instance Ppr FunDep where
ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)
ppr_list [] = empty
ppr_list xs = char '|' <+> commaSep xs
ppr_list xs = bar <+> commaSep xs
------------------------------
instance Ppr FamFlavour where
......@@ -452,7 +454,7 @@ instance Ppr FamilyResultSig where
------------------------------
instance Ppr InjectivityAnn where
ppr (InjectivityAnn lhs rhs) =
char '|' <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)
bar <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)
------------------------------
instance Ppr Foreign where
......@@ -655,6 +657,7 @@ pprParendType (ConT c) = ppr c
pprParendType (TupleT 0) = text "()"
pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma))
pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma
pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar
pprParendType ArrowT = parens (text "->")
pprParendType ListT = text "[]"
pprParendType (LitT l) = pprTyLit l
......@@ -795,3 +798,15 @@ commaSepWith pprFun = sep . punctuate comma . map pprFun
-- followed by space.
semiSep :: Ppr a => [a] -> Doc
semiSep = sep . punctuate semi . map ppr
-- Prints out the series of vertical bars that wraps an expression or pattern
-- used in an unboxed sum.
unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc
unboxedSumBars d alt arity = hashParens $
bars (alt-1) <> d <> bars (arity - alt)
where
bars i = hsep (replicate i bar)
-- Text containing the vertical bar character.
bar :: Doc
bar = char '|'
......@@ -1176,8 +1176,6 @@ mk_unboxed_tup_name n_commas space
occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
tup_mod = mkModName "GHC.Tuple"
-----------------------------------------------------
-- Locations
-----------------------------------------------------
......@@ -1278,6 +1276,19 @@ In 'ClassOpI' and 'DataConI', name of the parent class or type
-}
type ParentName = Name
-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a
-- particular data constructor. 'SumAlt's are one-indexed and should never
-- exceed the value of its corresponding 'SumArity'. For example:
--
-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)
--
-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)
type SumAlt = Int
-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of
-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.
type SumArity = Int
-- | In 'PrimTyConI', arity of the type constructor
type Arity = Int
......@@ -1398,26 +1409,27 @@ data Lit = CharL Char
-- | Pattern in Haskell given in @{}@
data Pat
= LitP Lit -- ^ @{ 5 or \'c\' }@
| VarP Name -- ^ @{ x }@
| TupP [Pat] -- ^ @{ (p1,p2) }@
| UnboxedTupP [Pat] -- ^ @{ (\# p1,p2 \#) }@
| ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
| InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
| UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
--
-- See "Language.Haskell.TH.Syntax#infix"
| ParensP Pat -- ^ @{(p)}@
--
-- See "Language.Haskell.TH.Syntax#infix"
| TildeP Pat -- ^ @{ ~p }@
| BangP Pat -- ^ @{ !p }@
| AsP Name Pat -- ^ @{ x \@ p }@
| WildP -- ^ @{ _ }@
| RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@
| ListP [ Pat ] -- ^ @{ [1,2,3] }@
| SigP Pat Type -- ^ @{ p :: t }@
| ViewP Exp Pat -- ^ @{ e -> p }@
= LitP Lit -- ^ @{ 5 or \'c\' }@
| VarP Name -- ^ @{ x }@
| TupP [Pat] -- ^ @{ (p1,p2) }@
| UnboxedTupP [Pat] -- ^ @{ (\# p1,p2 \#) }@
| UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@
| ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
| InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
| UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@
--
-- See "Language.Haskell.TH.Syntax#infix"
| ParensP Pat -- ^ @{(p)}@
--
-- See "Language.Haskell.TH.Syntax#infix"
| TildeP Pat -- ^ @{ ~p }@
| BangP Pat -- ^ @{ !p }@
| AsP Name Pat -- ^ @{ x \@ p }@
| WildP -- ^ @{ _ }@
| RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@
| ListP [ Pat ] -- ^ @{ [1,2,3] }@
| SigP Pat Type -- ^ @{ p :: t }@
| ViewP Exp Pat -- ^ @{ e -> p }@
deriving( Show, Eq, Ord, Data, Generic )
type FieldPat = (Name,Pat)
......@@ -1452,6 +1464,7 @@ data Exp
| LamCaseE [Match] -- ^ @{ \\case m1; m2 }@
| TupE [Exp] -- ^ @{ (e1,e2) } @
| UnboxedTupE [Exp] -- ^ @{ (\# e1,e2 \#) } @
| UnboxedSumE Exp SumAlt SumArity -- ^ @{ (\#|e|\#) }@
| CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@
| MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
| LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@
......@@ -1804,6 +1817,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<t
-- See Note [Representing concrete syntax in types]
| TupleT Int -- ^ @(,), (,,), etc.@
| UnboxedTupleT Int -- ^ @(\#,\#), (\#,,\#), etc.@
| UnboxedSumT SumArity -- ^ @(\#|\#), (\#||\#), etc.@
| ArrowT -- ^ @->@
| EqualityT -- ^ @~@
| ListT -- ^ @[]@
......
......@@ -8,6 +8,8 @@
`PatSynSigD`), and two new data types (`PatSynDir` and `PatSynArgs`),
among other changes. (#8761)
* Add support for unboxed sums. (#12478)
## 2.11.0.0 *May 2016*
* Bundled with GHC 8.0.1
......
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedSums #-}
module Main where
import Language.Haskell.TH
data T = T (# Int | Char #)
$(return [])
main :: IO ()
main = putStrLn $(reify ''T >>= stringE . show)
TyConI (DataD [] Main.T [] Nothing [NormalC Main.T [(Bang NoSourceUnpackedness NoSourceStrictness,AppT (AppT (UnboxedSumT 2) (ConT GHC.Types.Int)) (ConT GHC.Types.Char))]] [])
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedSums #-}
-- Essentially the same as TH_repUnboxedTuples, but for unboxed sums
module Main where
import Language.Haskell.TH
main :: IO ()
main = case bar () of
(# a | #) -> print a
(# | b #) -> print b
bar :: () -> (# String | Int #)
bar () = $( do e <- [| case (# 'b' | #) of
(# 'a' | #) -> (# "One" | #)
(# 'b' | #) -> (# | 2 #)
(# _ | #) -> (# "Three" | #)
(# | _ #) -> (# | 4 #)
|]
return e )
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedSums #-}
module T12478_3 where
import Language.Haskell.TH
$(do let ubxSum = unboxedSumT 2 `appT` conT ''Int `appT` conT ''Int
x <- newName "x"
y <- newName "y"
[d| swap :: $(ubxSum) -> $(ubxSum)
swap $(unboxedSumP (varP x) 1 2) = $(unboxedSumE (varE x) 2 2)
swap $(unboxedSumP (varP y) 2 2) = $(unboxedSumE (varE y) 1 2)
|])
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UnboxedSums #-}
module T12478_4 where
import Language.Haskell.TH
f :: $(unboxedSumT 1 `appT` conT ''()) -> Int
f _ = 42
T12478_4.hs:7:8: error:
• Illegal sum arity: 1
Sums must have an arity of at least 2
When splicing a TH type: (# #) GHC.Tuple.()
• In the untyped splice: $(unboxedSumT 1 `appT` conT ''())
......@@ -421,4 +421,9 @@ test('T12130', extra_clean(['T12130a.hi','T12130a.o']),
test('T12403', omit_ways(['ghci']),
compile_and_run, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T12407', omit_ways(['ghci']), compile, ['-v0'])
test('T12478_1', omit_ways(['ghci']), compile_and_run,
['-v0 -dsuppress-uniques'])
test('T12478_2', omit_ways(['ghci']), compile_and_run, ['-v0'])
test('T12478_3', omit_ways(['ghci']), compile, ['-v0'])
test('T12478_4', omit_ways(['ghci']), compile_fail, ['-v0'])
test('T12513', omit_ways(['ghci']), compile_fail, ['-v0'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment