
Hi. I've started using template haskell (replacing some preprocessor stuff) However I had real trouble when trying to convert instance (Show d) => Show (C d) where show _ = "C " ++ (show (undefined :: d)) into th. Why? It didn't compile (http://hpaste.org/289) Heffalump on #haskell suggested that the d is already in scope so I don't need the first list item of ForallT .. And that does work fine. So is this a bug in the [d| .. parser / to abstract syntax tree transformer ? Session showing this behviour: marc@localhost ~ $ cat ABC.hs {-# OPTIONS_GHC -fglasgow-exts #-} module ABC where data C d marc@localhost ~ $ ghci -fth ___ ___ _ / _ \ /\ /\/ __(_) / /_\// /_/ / / | | GHC Interactive, version 6.6, for Haskell 98. / /_\\/ __ / /___| | http://www.haskell.org/ghc/ \____/\/ /_/\____/|_| Type :? for help. Loading package base ... linking ... done. Prelude> :l ABC [1 of 1] Compiling ABC ( ABC.hs, interpreted ) Ok, modules loaded: ABC. *ABC> :m +Language.Haskell.TH *ABC Language.Haskell.TH> runQ [d| instance (Show d) => Show (C d) where show _ = "C " ++ (show (undefined :: d)) |] >>= print Loading package template-haskell ... linking ... done. [InstanceD [AppT (ConT GHC.Show.Show) (VarT d_0)] (AppT (ConT GHC.Show.Show) (AppT (ConT ABC.C) (VarT d_0))) [FunD show [Clause [WildP] (NormalB (InfixE (Just (LitE (StringL "C "))) (VarE GHC.Base.++) (Just (AppE (VarE show) (SigE (VarE GHC.Err.undefined) (ForallT [d_1] [] (VarT d_1))))))) []]]] *ABC Language.Haskell.TH> Now (ForallT [d_1] [] (VarT d_1) should be (ForallT [] [] (VarT d_1) shouldn't it? Marc Weber