Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/e558ca2f5828577a61e1f6dd9e26e88405e361e1 >--------------------------------------------------------------- commit e558ca2f5828577a61e1f6dd9e26e88405e361e1 Author: Iavor S. Diatchki <[email protected]> Date: Thu Mar 15 00:08:06 2012 -0700 Updates to type-literal support. >--------------------------------------------------------------- Language/Haskell/TH/Lib.hs | 15 ++++++++------- Language/Haskell/TH/Ppr.hs | 6 +++--- Language/Haskell/TH/Syntax.hs | 6 +++--- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index 5ead7b5..2a9f886 100644 --- a/Language/Haskell/TH/Lib.hs +++ b/Language/Haskell/TH/Lib.hs @@ -461,8 +461,8 @@ arrowT = return ArrowT listT :: TypeQ listT = return ListT -literalT :: TyLit -> TypeQ -literalT l = return (LiteralT l) +litT :: TyLit -> TypeQ +litT l = return (LitT l) tupleT :: Int -> TypeQ tupleT i = return (TupleT i) @@ -490,10 +490,14 @@ varStrictType v st = do (s, t) <- st -- * Type Literals -numberTL :: Integer -> TyLitQ -numberTL n = if n >= 0 then return (NumberTL n) +numTyLit :: Integer -> TyLitQ +numTyLit n = if n >= 0 then return (NumTyLit n) else fail ("Negative type-level number: " ++ show n) +strTyLit :: String -> TyLitQ +strTyLit s = return (StrTyLit s) + + ------------------------------------------------------------------------------- -- * Kind @@ -507,9 +511,6 @@ kindedTV = KindedTV starK :: Kind starK = StarK -natK :: Kind -natK = NatK - arrowK :: Kind -> Kind -> Kind arrowK = ArrowK diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs index 0e32206..dc2ccae 100644 --- a/Language/Haskell/TH/Ppr.hs +++ b/Language/Haskell/TH/Ppr.hs @@ -388,7 +388,7 @@ 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 (LiteralT l) = pprTyLit l +pprParendType (LitT l) = pprTyLit l pprParendType other = parens (ppr other) instance Ppr Type where @@ -418,7 +418,8 @@ split t = go t [] go ty args = (ty, args) pprTyLit :: TyLit -> Doc -pprTyLit (NumberTL n) = integer n +pprTyLit (NumTyLit n) = integer n +pprTyLit (StrTyLit s) = text (show s) instance Ppr TyLit where ppr = pprTyLit @@ -430,7 +431,6 @@ instance Ppr TyVarBndr where instance Ppr Kind where ppr StarK = char '*' - ppr NatK = text "Nat" ppr (ArrowK k1 k2) = pprArrowArgKind k1 <+> text "->" <+> ppr k2 pprArrowArgKind :: Kind -> Doc diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index 1e71ff5..72e644b 100644 --- a/Language/Haskell/TH/Syntax.hs +++ b/Language/Haskell/TH/Syntax.hs @@ -987,18 +987,18 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall <vars>. <ctxt> -> <type>@ | ListT -- ^ @[]@ | AppT Type Type -- ^ @T a b@ | SigT Type Kind -- ^ @t :: k@ - | LiteralT TyLit -- ^ @0,1,2, etc.@ + | LitT TyLit -- ^ @0,1,2, etc.@ deriving( Show, Eq, Data, Typeable ) data TyVarBndr = PlainTV Name -- ^ @a@ | KindedTV Name Kind -- ^ @(a :: k)@ deriving( Show, Eq, Data, Typeable ) -data TyLit = NumberTL Integer +data TyLit = NumTyLit Integer + | StrTyLit String deriving ( Show, Eq, Data, Typeable ) data Kind = StarK -- ^ @'*'@ - | NatK -- ^ @Nat@ | ArrowK Kind Kind -- ^ @k1 -> k2@ deriving( Show, Eq, Data, Typeable ) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
