[Haskell-cafe] Template Haskell ListT wrinkle

Robert Greayer robgreayer at yahoo.com
Tue Jun 24 15:43:22 EDT 2008


In messing around with TH, I noticed (what I consider
to be an) odd wrinkle in the handling of list types
within TH's syntax meta-data.  For example, given the
program at the end of this email, which prints out the
TH representation of the types 'Ints' and '[Int]',
where 'Ints' is just a type-alias for '[Int]', the
following results are generated:

Ints is: AppT (ConT GHC.Base.[]) (ConT GHC.Base.Int)
[Int] is: AppT ListT (ConT GHC.Base.Int)

type0, 'Ints' resolves to the application of the named
type constructor "GHC.Base.[]" to the named type
constructor "GHC.Base.Int" (which makes perfect
sense).  type1, '[Int]' resolves to the application of
the 'built-in' ListT type constructor to the named
type constructor "GHC.Base.Int" (which also makes
perfect sense).  What's odd (to me) is that in one
situation, the 'named' constructor 'GHC.Base.[]'
appears, and in the other, the 'built-in' constructor
appears.

Does anyone have insight into why this might be? 
(These results were obtained with GHC 6.8.2, btw).

> {-# OPTIONS_GHC -XTemplateHaskell #-}
> module Main where
> import Language.Haskell.TH
>
> type Ints = [Int]
>
> type0 = $( reify ''Ints >>= (\ (TyConI (TySynD _ _
t)) -> return $ show t) >>= \s -> [| s |])
> type1 = $( [t| [Int] |] >>= return . show >>= \s ->
[| s |])
>
> main = do
>    putStrLn ("Ints is: " ++ type0)
>    putStrLn ("[Int] is: " ++ type1)

Thanks
rcg


      


More information about the Haskell-Cafe mailing list