Commit 3b1ec6e1 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add unboxed tuple support to Template Haskell

parent bbf06bfd
......@@ -64,6 +64,8 @@ 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)}
conP :: Name -> [PatQ] -> PatQ
conP n ps = do ps' <- sequence ps
return (ConP n ps')
......@@ -226,6 +228,9 @@ lam1E p e = lamE [p] e
tupE :: [ExpQ] -> ExpQ
tupE es = do { es1 <- sequence es; return (TupE es1)}
unboxedTupE :: [ExpQ] -> ExpQ
unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)}
......@@ -443,6 +448,9 @@ listT = return ListT
tupleT :: Int -> TypeQ
tupleT i = return (TupleT i)
unboxedTupleT :: Int -> TypeQ
unboxedTupleT i = return (UnboxedTupleT i)
sigT :: TypeQ -> Kind -> TypeQ
sigT t k
= do
......
......@@ -108,6 +108,7 @@ pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1
pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)
<+> text "->" <+> ppr e
pprExp _ (TupE es) = parens $ sep $ punctuate comma $ map ppr es
pprExp _ (UnboxedTupE es) = hashParens $ sep $ punctuate comma $ map ppr es
-- 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,
......@@ -190,6 +191,7 @@ pprPat :: Precedence -> Pat -> Doc
pprPat i (LitP l) = pprLit i l
pprPat _ (VarP v) = pprName' Applied v
pprPat _ (TupP ps) = parens $ sep $ punctuate comma $ map ppr ps
pprPat _ (UnboxedTupP ps) = hashParens $ sep $ punctuate comma $ map ppr ps
pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s
<+> sep (map (pprPat appPrec) ps)
pprPat i (InfixP p1 n p2)
......@@ -379,6 +381,7 @@ pprParendType (VarT v) = ppr v
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 ArrowT = parens (text "->")
pprParendType ListT = text "[]"
pprParendType other = parens (ppr other)
......@@ -453,3 +456,6 @@ where_clause ds = nest nestDepth $ text "where" <+> vcat (map (ppr_dec False) ds
showtextl :: Show a => a -> Doc
showtextl = text . map toLower . show
hashParens :: Doc -> Doc
hashParens d = text "(# " <> d <> text " #)"
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
-- The -fno-warn-warnings-deprecations flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
......@@ -45,6 +46,7 @@ module Language.Haskell.TH.Syntax(
NameFlavour(..), NameSpace (..),
mkNameG_v, mkNameG_d, mkNameG_tc, Uniq, mkNameL, mkNameU,
tupleTypeName, tupleDataName,
unboxedTupleTypeName, unboxedTupleDataName,
OccName, mkOccName, occString,
ModName, mkModName, modString,
PkgName, mkPkgName, pkgString
......@@ -557,17 +559,17 @@ showName' ni nm
instance Show Name where
show = showName
-- Tuple data and type constructors
-- Tuple data and type constructors
tupleDataName :: Int -> Name -- ^ Data constructor
tupleTypeName :: Int -> Name -- ^ Type constructor
tupleDataName 0 = mk_tup_name 0 DataName
tupleDataName 0 = mk_tup_name 0 DataName
tupleDataName 1 = error "tupleDataName 1"
tupleDataName n = mk_tup_name (n-1) DataName
tupleDataName n = mk_tup_name (n-1) DataName
tupleTypeName 0 = mk_tup_name 0 TcClsName
tupleTypeName 0 = mk_tup_name 0 TcClsName
tupleTypeName 1 = error "tupleTypeName 1"
tupleTypeName n = mk_tup_name (n-1) TcClsName
tupleTypeName n = mk_tup_name (n-1) TcClsName
mk_tup_name :: Int -> NameSpace -> Name
mk_tup_name n_commas space
......@@ -577,6 +579,25 @@ mk_tup_name n_commas space
-- XXX Should it be GHC.Unit for 0 commas?
tup_mod = mkModName "GHC.Tuple"
-- Unboxed tuple data and type constructors
unboxedTupleDataName :: Int -> Name -- ^ Data constructor
unboxedTupleTypeName :: Int -> Name -- ^ Type constructor
unboxedTupleDataName 0 = error "unboxedTupleDataName 0"
unboxedTupleDataName 1 = error "unboxedTupleDataName 1"
unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName
unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"
unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"
unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName
mk_unboxed_tup_name :: Int -> NameSpace -> Name
mk_unboxed_tup_name n_commas space
= Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)
where
occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")
tup_mod = mkModName "GHC.Tuple"
-----------------------------------------------------
......@@ -691,6 +712,7 @@ 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@
| TildeP Pat -- ^ @{ ~p }@
......@@ -736,6 +758,7 @@ data Exp
| LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@
| TupE [Exp] -- ^ @{ (e1,e2) } @
| UnboxedTupE [Exp] -- ^ @{ (# e1,e2 #) } @
| CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@
| LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@
| CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@
......@@ -855,6 +878,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall <vars>. <ctxt> -> <type>@
| VarT Name -- ^ @a@
| ConT Name -- ^ @T@
| TupleT Int -- ^ @(,), (,,), etc.@
| UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@
| ArrowT -- ^ @->@
| ListT -- ^ @[]@
| AppT Type Type -- ^ @T a b@
......
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