[Bug?] AST representation of type-synonyms with phantom parameters
Hi, There seems to be a bug in the type representation of type synonyms with phantom parameters === Phantom.hs === module Phantom where -- non-phantom type synonym type List a = [a] type PhantomSyn a = Int data PhantomData a = PhantomData Int ================== ~/ghc/ghc/compiler/stage2$ ./ghc-inplace -fth --interactive /tmp/Phantom.hs GHCi, version 6.9.20071025: http://www.haskell.org/ghc/ :? for help Loading package base ... linking ... done. [1 of 1] Compiling Phantom ( /tmp/Phantom.hs, interpreted ) Ok, modules loaded: Phantom. *Phantom> let {syn = undefined :: List a; phanSyn = undefined :: PhantomSyn a; phanData = undefined :: PhantomData a} *Phantom> :m +Language.Haskell.TH *Phantom Language.Haskell.TH> let showType name = do {VarI _ t _ _ <- reify name ; runIO $ putStrLn (pprint t); [| 1 |]} Loading package array-0.1 ... linking ... done. Loading package packedstring-0.1 ... linking ... done. Loading package containers-0.1 ... linking ... done. Loading package pretty-1.0 ... linking ... done. Loading package template-haskell ... linking ... done. *Phantom Language.Haskell.TH> $(showType (mkName "syn")) forall a_0 . Phantom.List a_0 forall a_0 . Phantom.List a_0 forall a_0 . Phantom.List a_0 forall a_0 . Phantom.List a_0 1 *Phantom Language.Haskell.TH> $(showType (mkName "phanSyn")) Phantom.PhantomSyn GHC.Prim.Any Phantom.PhantomSyn GHC.Prim.Any Phantom.PhantomSyn GHC.Prim.Any Phantom.PhantomSyn GHC.Prim.Any 1 *Phantom Language.Haskell.TH> $(showType (mkName "phanData")) forall a_0 . Phantom.PhantomData a_0 forall a_0 . Phantom.PhantomData a_0 forall a_0 . Phantom.PhantomData a_0 forall a_0 . Phantom.PhantomData a_0 1 The output makes sense for "forall a_0 . Phantom.List a_0" and "forall a_0 . Phantom.PhantomData a_0" but why "Phantom.PhantomSyn GHC.Prim.Any"? (just for information purposes, ghc 6.6 uses "()" instead of "Any") Shouldn't it be "forall a_0 . Phantom.PhantomSyn a_0"? Best Regards, Fons PS: BTW, $(showType 'phanSyn) works fine in ghci6.6 but gives a Stage error in HEAD. That's why I used mkName "phanSyn" Is that another bug? (I couldn't find a related ticket in GHC's trac)
It seems to be a general GHC-issue (due to the internal representation of type-synonyms with phantom types) For example: *Phantom Language.Haskell.TH> let f = (\_-> 1) :: PhantomSyn a -> Int *Phantom Language.Haskell.TH> f "a" <interactive>:1:2: Couldn't match expected type `PhantomSyn GHC.Prim.Any' against inferred type `[Char]' Expected type: PhantomSyn GHC.Prim.Any Inferred type: [Char] In the first argument of `f', namely `"a"' In the expression: f "a" Pay attention to the error, it says: PhantomSyn GHC.Prim.Any instead of Expected type: PhantomSyn a Again, should this be considered a bug? I don't think the end-user should know anything about GHC.Prim.Any. The error is a bit confusing. However, I still think that independently of how does GHC represent type synonyms with phantom parameters, TH should represent their type variables as such, and not as "GHC.Prim.Any"
On Mon, Oct 29, 2007 at 02:27:37PM +0100, Alfonso Acosta wrote:
Again, should this be considered a bug?
These all look like bugs to me. Please feel free to file them: http://hackage.haskell.org/trac/ghc/wiki/ReportABug
I don't think the end-user should know anything about GHC.Prim.Any.
That's correct, as I understand it. Thanks Ian
The bug seems to be a general issue of GHC and I included it as such:
http://hackage.haskell.org/trac/ghc/ticket/1813
I also created a ticket for the lightweight quoting Stage error
http://hackage.haskell.org/trac/ghc/ticket/1814
On 10/29/07, Ian Lynagh
On Mon, Oct 29, 2007 at 02:27:37PM +0100, Alfonso Acosta wrote:
Again, should this be considered a bug?
These all look like bugs to me. Please feel free to file them: http://hackage.haskell.org/trac/ghc/wiki/ReportABug
I don't think the end-user should know anything about GHC.Prim.Any.
That's correct, as I understand it.
Thanks Ian
participants (2)
-
Alfonso Acosta -
Ian Lynagh