[Haskell-cafe] Type error

Alfonso Acosta alfonso.acosta at gmail.com
Fri Apr 6 13:33:45 EDT 2007


Thanks for your answer, The functional dependencies solution doesn't
help because my instances cannot satisfy them (there are various
DestPort and SourcePort instances with are required to support various
HDSignals). I tried with existentials, but I'm still getting an error
(I'm not that comfortable working with existentials yet :)).

Example.hs:24:41:
    Couldn't match expected type `forall a.
                                  (HDPrimType a) =>
                                  HDSignal a -> b'
           against inferred type `(forall a. (HDPrimType a) => HDSignal a)
                                  -> d'
    In the second argument of `($)', namely `(push2 supplySig) dix d'
    In the expression: (plugSig six s) $ ((push2 supplySig) dix d)
    In the definition of `connectIx':
        connectIx six s dix d = (plugSig six s) $ ((push2 supplySig) dix d)


Here is the code

module Example where


data HDSignal a = HDSignal
class HDPrimType a where
class PortIndex  a where

class SourcePort s where
 -- Plug an external signal to the port
 plugSig  :: (HDPrimType a, PortIndex ix) => ix -> s  -> (forall
a.HDPrimType a => HDSignal a -> b) -> b

class DestPort d where
 -- Supply a signal to the port
 supplySig  :: (PortIndex ix, HDPrimType a) => (forall a. HDPrimType a
=> HDSignal a) -> ix -> d -> d


-- Connect providing indexes
connectIx :: (SourcePort s, PortIndex six, DestPort d, PortIndex dix) =>
             six -> s -> dix -> d -> d
-- This can seem ugly,
-- it would be easier for us having different types for plugSig and supplySig
-- but the final user would find it much more difficult to deal with
-- supplysig
connectIx six s dix d = plugSig six s $ (push2 supplySig) dix d


push2 :: (a -> b -> c -> d) -> b -> c -> a -> d
push2 f = (\b c a -> f a b c)



On 4/6/07, Chris Kuklewicz <haskell at list.mightyreason.com> wrote:
> I'll explain a little bit.
>
> Consider (show (read "13")).  The compiler has no way to know what the type "a"
> produced by read should be.  It must be an instance of (Read a) and (Show a),
> but the compiler cannot generate any actual code!
>
>
> Alfonso Acosta wrote:
> > Hi all,
> >
> > I have a type problem in my code which I dont know how to solve (and
> > I'm not really sure why is caused). I have made a simplified example,
> > can anyone have a look at it?
> >
> > Thanks in advance,
> >
> > The error is:
> >
> > Example.hs:24:47:
> >    Ambiguous type variable `a' in the constraint:
> >      `HDPrimType a'
> >        arising from use of `supplySig' at Example.hs:24:47-55
> >    Probable fix: add a type signature that fixes these type variable(s)
> >
> >
> > Here is the code
>
> I have further simplified the example, removing and reordering parameters.
>
> >
> > ---
> > module Example where
> >
> >
> > data HDSignal a = HDSignal
>
> The above lets you use constructor HDSignal to create type (HDSignal a) for any
> type "a".
>
> > class HDPrimType a where
> > class PortIndex a where
> >
> > class SourcePort s where
> > -- Plug an external signal to the port
> > plugSig  :: (HDPrimType a) => s  -> (HDSignal a -> b) -> b
>
> The above is odd, in that the plugSig can internally produce (HDPrimType a =>
> HDSignal a) for any "a" that satisfies the constraint.
>
> Perhaps you want to use a functional dependency?
>
> > class SourcePort s a | s -> a where
>
> Or perhaps you need an existential forall ?
>
> > plugSig  ::  s  -> (forall a. HDPrimType a=> HDSignal a -> b) -> b
>
> > class DestPort d where
> > -- Supply a signal to the port
> > supplySig  :: (PortIndex ix, HDPrimType a) => ix -> d -> HDSignal a -> d
> >
>
> The above is odd, in that the DestPort can take (HDPrimType a => HDSignal a) for
> any "a" that satisfies the constraint.
>
> Perhaps you really want the type "d" in (DestPort d) to imply a specific type
> "a" with a functional dependency?
>
> > class DestPort d a | d -> a where
>
> Or perhaps you need a forall?
>
> > supplySig  :: (PortIndex ix) => ix -> d -> (forall. HDPrimType a => HDSignal a) -> d
>
> > -- Connect providing indexes
> > connectIx :: (SourcePort s, DestPort d, PortIndex dix) =>
> >              s -> dix -> d -> d
> > -- This can seem ugly,
> > -- it would be easier for us having different types for plugSig and
> > supplySig
> > -- but the final user would find it much more difficult to deal with
> > -- supplysig
> > connectIx s dix d = plugSig s (supplySig dix d)
>
> The above produced the error because the compiler has no clue what the type "a"
> is in the signatures for supplySig and plugSit.
>


More information about the Haskell-Cafe mailing list