[Haskell-cafe] What causes this "Ambiguous type variable" message (involving an existential type)?

James Cook falsifian at falsifian.org
Sat Jul 18 17:33:38 UTC 2020


Hi haskell-cafe,

I've run into a strange error. It's easy for me to work around, but I
still would like to know what causes it.

Here's a minimal example.

{-# LANGUAGE Rank2Types #-}

module Example where

data T = T (forall n . (Show n) => n)

d :: a -> Int
d = undefined

f :: T -> Int
f (T t) = d t

when I try to compile it (ghc Example.hs) I see the following error:

Example.hs:11:13: error:
     • Ambiguous type variable ‘a0’ arising from a use of ‘t’
       prevents the constraint ‘(Show a0)’ from being solved.
       Probable fix: use a type annotation to specify what ‘a0’ should be.
       These potential instances exist:
         instance Show Ordering -- Defined in ‘GHC.Show’
         instance Show Integer -- Defined in ‘GHC.Show’
         instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
         ...plus 22 others
         ...plus 12 instances involving out-of-scope types
         (use -fprint-potential-instances to see them all)
     • In the first argument of ‘d’, namely ‘t’
       In the expression: d t
       In an equation for ‘f’: f (T t) = d t
    |
11 | f (T t) = d t
    |             ^

My question: what causes this error?

This seems backward to me. The way I see it, I've told the compiler
that any value of type T is guaranteed to contain a value of a type
implementing Show, so there should be no question about solving a
constraint involving Show. Moreover, the function "d" doesn't even
require its input to implement Show.

I'm guessing there's some basic rule about existential types that I'm
violating here, but I'm not sure where to look if I want to read about
that. I've skimmed https://wiki.haskell.org/Existential_type and
didn't find anything, but maybe I skimmed too quickly.

(Note: if I use Num or Fractional instead of Show, I don't get the
error. I guess it's because of defaulting rules for numeric type
classes.)

If you're interested in how I ran into this, here's a summary.

I have this type Scene g with two record fields. Notice the
gl_camera_info field doesn't mention the type parameter g.

data Scene g where
     Scene ::
       RandomGenD g =>
       {   part_ :: Part g
       ,   gl_camera_info :: GLCameraInfo
       }
       -> Scene g

Then later I have an existentially quantified scene passed to the
VScene constructor here...

data BaseVal =
         VIint Int
     |   VS String
     |   VScene (forall g . (RandomGenD g) => Scene g)
     |   VIO (ShellState -> IO ShellState)
     |   VError String

data Val =
         Val
         {   val_f :: Val -> Val
         ,   val_base :: BaseVal
         }

and later (somewhere inside a "where" clause):

f (Val _ (VScene scene)) = base_val (VIO (fork_render (gl_camera_info
scene) (RLS.muts scene 5e-2 1e-1)))

(I don't think the definitions of base_val or RLS.muts matter here.)

The use of gl_camera_info seems to cause the problem in this case. I see

Shell.hs:137:79: error:
     • Ambiguous type variable ‘g0’ arising from a use of ‘scene’
       prevents the constraint ‘(RandomGenD g0)’ from being solved.
       Probable fix: use a type annotation to specify what ‘g0’ should be.
       These potential instances exist:
         instance [safe] RandomGenD g => RandomGenD (RList g)
           -- Defined in ‘RList’
         instance [safe] RandomGenD StdGen -- Defined in ‘Rand’
     • In the first argument of ‘gl_camera_info’, namely ‘scene’
       In the first argument of ‘fork_render’, namely
         ‘(gl_camera_info scene)’
       In the first argument of ‘VIO’, namely
         ‘(fork_render (gl_camera_info scene) (RLS.muts scene 5e-2 1e-1))’
     |
137 |         f (Val _ (VScene scene)) = base_val (VIO (fork_render
(gl_camera_info scene) (RLS.muts scene 5e-2 1e-1)))
     |
              ^^^^^

My planned solution is simply to not use an existential type here. I
can just make g a parameter of the BaseVal type. But I'm still curious
to understand what went wrong.

--
James


More information about the Haskell-Cafe mailing list