[Haskell-cafe] Code that doesn't compile - but should :)
Chris Eidhof
chris at eidhof.nl
Tue Mar 16 05:39:18 EDT 2010
What about this?
> {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,
> UndecidableInstances, FlexibleContexts, EmptyDataDecls, ScopedTypeVariables,
> TypeOperators, TypeSynonymInstances #-}
>
> data Data k = Pair Integer (() -> k)
> data RecData = RecData (Data RecData)
> mk_data x = RecData(Pair x (\() -> mk_data (x+1)))
>
The I had to change the type of the Converter typeclass
> class Converter a f where convert :: f a -> a
>
> -- instance Converter RecData Data where
> -- convert (RecData r) = r
>
> class Selector s a where select :: s -> a
>
And explicitly quantify the type variables:
> f :: forall f s a . (Selector s (a->f a), Converter a f) => s -> (a->a)
> f s =
> let method = select s :: a -> f a
> in (\x ->
> let res = method x
> in convert res)
-chris
On 16 mrt 2010, at 10:36, Giuseppe Maggiore wrote:
> The error message (obtained by loading the file with ghci) is:
> GHCi, version 6.10.4: http://www.haskell.org/ghc/ :? for help
> Loading package ghc-prim ... linking ... done.
> Loading package integer ... linking ... done.
> Loading package base ... linking ... done.
> [1 of 1] Compiling Main ( C:\Users\pulcy\Desktop\Papers\Monads\Objec
> tiveMonad\HObject\Experiments\FunctorsProblems.hs, interpreted )
>
> C:\Users\pulcy\Desktop\Papers\Monads\ObjectiveMonad\HObject\Experiments\Functors
> Problems.hs:18:15:
> Could not deduce (Selector s (f a -> a))
> from the context (Selector s (a1 -> f1 a1), Converter a1 f1)
> arising from a use of `select'
> at C:\Users\pulcy\Desktop\Papers\Monads\ObjectiveMonad\HObjec
> t\Experiments\FunctorsProblems.hs:18:15-22
> Possible fix:
> add (Selector s (f a -> a)) to the context of
> the type signature for `f'
> or add an instance declaration for (Selector s (f a -> a))
> In the expression: select s
> In the definition of `method': method = select s
> In the expression:
> let method = select s in (\ x -> let res = ... in convert res)
>
> C:\Users\pulcy\Desktop\Papers\Monads\ObjectiveMonad\HObject\Experiments\Functors
> Problems.hs:21:11:
> Couldn't match expected type `a1' against inferred type `f a'
> `a1' is a rigid type variable bound by
> the type signature for `f'
> at C:\Users\pulcy\Desktop\Papers\Monads\ObjectiveMonad\HObject\Expe
> riments\FunctorsProblems.hs:16:18
> In the expression: convert res
> In the expression: let res = method x in convert res
> In the expression: (\ x -> let res = method x in convert res)
> Failed, modules loaded: none.
> Prelude>
>
>
> On Tue, Mar 16, 2010 at 2:31 AM, Ivan Lazar Miljenovic <ivan.miljenovic at gmail.com> wrote:
> Giuseppe Maggiore <giuseppemag at gmail.com> writes:
>
> > Hi! Can anyone tell me why this code does not work? I cannot seem to
> > figure why it is broken...
>
> The error message (and how you got it) would help...
>
> > {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances,
> > UndecidableInstances, FlexibleContexts, EmptyDataDecls, ScopedTypeVariables,
> > TypeOperators, TypeSynonymInstances #-}
>
> You sure you have enough language extensions there? ;-)
>
> Barely :)
>
>
> --
> Ivan Lazar Miljenovic
> Ivan.Miljenovic at gmail.com
> IvanMiljenovic.wordpress.com
>
>
>
> --
> Giuseppe Maggiore
> Ph.D. Student (Languages and Games)
> Microsoft Student Partner
> Mobile: +393319040031
> Office: +390412348444
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list