Updates to type-literal support.
authorIavor S. Diatchki <iavor.diatchki@gmail.com>
Thu, 15 Mar 2012 07:08:06 +0000 (00:08 -0700)
committerIavor S. Diatchki <iavor.diatchki@gmail.com>
Thu, 15 Mar 2012 07:08:06 +0000 (00:08 -0700)
Language/Haskell/TH/Lib.hs
Language/Haskell/TH/Ppr.hs
Language/Haskell/TH/Syntax.hs

index 5ead7b5..2a9f886 100644 (file)
@@ -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
 
index 0e32206..dc2ccae 100644 (file)
@@ -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
index 1e71ff5..72e644b 100644 (file)
@@ -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 )