Changes for TypeNats.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 19 Jun 2011 05:46:09 +0000 (22:46 -0700)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Sun, 19 Jun 2011 05:46:09 +0000 (22:46 -0700)
libraries/template-haskell/Language/Haskell/TH/Lib.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index fc8ab76..9c40718 100644 (file)
@@ -22,6 +22,7 @@ type DecQ           = Q Dec
 type DecsQ          = Q [Dec]
 type ConQ           = Q Con
 type TypeQ          = Q Type
+type TyLitQ         = Q TyLit
 type CxtQ           = Q Cxt
 type PredQ          = Q Pred
 type MatchQ         = Q Match
@@ -445,6 +446,9 @@ arrowT = return ArrowT
 listT :: TypeQ
 listT = return ListT
 
+literalT :: TyLit -> TypeQ
+literalT l = return (LiteralT l)
+
 tupleT :: Int -> TypeQ
 tupleT i = return (TupleT i)
 
@@ -468,6 +472,13 @@ varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ
 varStrictType v st = do (s, t) <- st
                         return (v, s, t)
 
+-- * Type Literals
+
+numberTL :: Integer -> TyLitQ
+numberTL n = if n >= 0 then return (NumberTL n)
+                       else fail ("Negative type-level number: " ++ show n)
+
+
 -------------------------------------------------------------------------------
 -- *   Kind
 
@@ -480,6 +491,9 @@ kindedTV = KindedTV
 starK :: Kind
 starK = StarK
 
+natK :: Kind
+natK = NatK
+
 arrowK :: Kind -> Kind -> Kind
 arrowK = ArrowK
 
index 6c324f0..426579e 100644 (file)
@@ -384,6 +384,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 other      = parens (ppr other)
 
 instance Ppr Type where
@@ -412,6 +413,12 @@ split t = go t []
     where go (AppT t1 t2) args = go t1 (t2:args)
           go ty           args = (ty, args)
 
+pprTyLit :: TyLit -> Doc
+pprTyLit (NumberTL n) = integer n
+
+instance Ppr TyLit where
+  ppr = pprTyLit
+
 ------------------------------
 instance Ppr TyVarBndr where
     ppr (PlainTV nm)    = ppr nm
@@ -419,6 +426,7 @@ 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
index b763aba..ae20d59 100644 (file)
@@ -34,6 +34,7 @@ module Language.Haskell.TH.Syntax(
 
        -- * The algebraic data types
        Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..),Cxt,
+        TyLit(..),
        Pred(..), Match(..),  Clause(..), Body(..), Guard(..), Stmt(..),
        Range(..), Lit(..), Pat(..), FieldExp, FieldPat, ClassInstance(..),
        Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
@@ -883,13 +884,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,...
       deriving( Show, Eq, Data, Typeable )
 
 data TyVarBndr = PlainTV  Name            -- ^ @a@
                | KindedTV Name Kind       -- ^ @(a :: k)@
       deriving( Show, Eq, Data, Typeable )
 
+data TyLit = NumberTL Integer
+  deriving ( Show, Eq, Data, Typeable )
+
 data Kind = StarK                         -- ^ @'*'@
+          | NatK                          -- ^ @Nat@
           | ArrowK Kind Kind              -- ^ @k1 -> k2@
       deriving( Show, Eq, Data, Typeable )