[Haskell-cafe] ambiguous partially defined type problem

Brian Hulley brianh at metamilk.com
Thu Sep 14 11:43:55 EDT 2006


Maarten wrote:
> For a project involving I use some partially defined node (in this
> case a simple record, in my project state transformers) in which the
> defined part is common to all nodes, and the custom part is different
> for each node. They have to become anonymous so I can put them in a
> list of connections from each node to another.
>
> For some reason GHC complains of 'ambigous type variable' in the code
> below. The thing is, part of the code may be undefined, but since I'm
> (explicitly) not using that part, why would GHC care? Are there other
> solutions to this problem? Any pointers or comments appreciated.
>
> -- data structure with custom and common part
> data Node cust = Node cust Common
>    deriving (Show,Typeable)
>
> -- anonymous data structure to put use in list
> data AN = forall ar. (Show ar, Typeable ar) => AN ar
>
> instance Show AN where
>    show (AN an) = "AN (" ++ show an ++ ")"
>
> -- common part
> data Common = Common Integer
>    deriving (Show,Typeable)
>
> data Custom = Custom Integer
>    deriving (Show,Typeable)
>
> data Custom2 = Custom2 Integer
>    deriving (Show,Typeable)
>
> -- extract common part, ignoring type of custom part
> getCommon :: forall gc. (Node gc) -> Common
> getCommon (Node cust com) = com
>
> main = do
>    let a = AN (Node (Custom 5) (Common 10))
>    let b = case a of (AN a') -> getCommon (case (cast a') of Just a''
> -> a'')
>    putStrLn $ "ok:" ++ show b

Hi Maarten -
The problem is that AN is far too general. The compiler can't tell that 
you've wrapped a Node, so the call to getCommon will fail to typecheck.

Even if the compiler did know, by some other means, that a Node had been 
wrapped, Haskell doesn't support true existentials, so the type signature 
for getCommon doesn't do what I think you mean ie:

    getCommon :: forall gc. (Node gc) -> Common

is the same as writing:

    getCommon :: Node gc -> Common

whereas you'd really need an existential:

    getCommon :: (forall gc. Node gc) -> Common

The fact that gc is not used in the definition of getCommon doesn't matter, 
since the type system has to just use the same rules for type inference 
regardless of the content of the function. In other words, without true 
existentials, or some other extension to the type system, there is no way to 
propagate the fact that the actual binding for a type variable is never 
required. Also, AFAIK there is no guarantee that Node Int Common and Node 
String Common would always be laid out in memory in the same way - the 
compiler is allowed to use special optimized layouts for particular 
instantiations of cust (even though it probably won't be clever enough to do 
this at the moment in Haskell implementations).

I suggest you wrap the custom part separately instead of wrapping the whole 
Node eg:

    data Custom = forall cust. ICusom cust => Custom cust

    data Node = Node Custom Common

where the ICustom class is whatever class you need to be able to do anything 
useful with cust.
Alternatively, you could wrap the custom part within the node as in:

    data Node = forall cust. ICustom cust => Node cust Custom

    getCommon :: Node -> Common
    getCommon (Node cust com) = com

Regards, Brian.
-- 
Logic empowers us and Love gives us purpose.
Yet still phantoms restless for eras long past,
congealed in the present in unthought forms,
strive mightily unseen to destroy us.

http://www.metamilk.com 



More information about the Haskell-Cafe mailing list