[Haskell-cafe] GHCi gives type signature that won't compile.
Miguel Mitrofanov
miguelimo38 at yandex.ru
Thu Jun 5 12:36:21 EDT 2008
Check your types for typos.
On 5 Jun 2008, at 20:31, A A wrote:
> Hi All
>
> I can successfully compile the following code using ghci
>
> import Data.Array.IArray
>
> makeArray (lower, upper) f = listArray (lower, upper) [(f i) | i <-
> [lower..upper]
> tridiagonal_solve (a, b, c, d, (lower, upper)) = x
> where
> gen_array f = (makeArray (lower, upper) f)
> x = gen_array x_f
> where
> x_f i
> | i == upper = (d_dash ! upper)
> | otherwise = (d_dash ! i) - (c_dash !
> i) * (x ! (i + 1))
> d_dash = gen_array d_dash_f
> where
> d_dash_f i
> | i == lower = (d ! lower) / (b ! lower)
> | otherwise = ((d ! i) - (d_dash ! (i -
> 1)) * (a ! i)) /
> ((b ! i) - (c_dash ! (i -
> 1)) * (a ! i))
> c_dash = gen_array c_dash_f
> where
> c_dash_f i
> | i == lower = (c ! lower) / (b ! lower)
> | otherwise = (c ! i) /
> ((b ! i) - (c_dash ! (i -
> 1)) * (a ! i))
>
> I then attempted to write a type signature for tridiagonal_solve. I
> didn't succeed at this however, all of my type signatures gave
> compile errors when attempting to load them in ghci. I asked in the
> #haskell channel, and they suggested that I try the type signature
> from ghci :type function.
>
> So I removed any type signatures, and reloaded the file in ghci, and
> typed ":type tridiagonal_solve" which produced the following output:
>
> tridiagonal_solve :: (IArray a3 e,
> IArray a6 e,
> IArray a7 e,
> Fractional e,
> Ix a,
> Num a,
> IArray a4 e,
> IArray a2 e,
> IArray a5 e,
> IArray a1 e,
> Enum a) =>
> (a4 a e, a2 a e, a1 a e, a5 a e, (a, a)) -> a7
> a e
>
> I then attempted to paste this into my code, the resulting code
> looking like this:
>
> import Data.Array.IArray
>
> makeArray (lower, upper) f = listArray (lower, upper) [(f i) | i <-
> [lower..upper]]
>
> tridiagonal_solve :: (IArray a3 e,
> IArray a6 e,
> IArray a7 e,
> Fractional e,
> Ix a,
> Num a,
> IArray a4 e,
> IArray a2 e,
> IArray a5 e,
> IArray a1 e,
> Enum a) =>
> (a4 a e, a2 a e, a1 a e, a5 a e, (a, a)) -> a7
> a e
>
> tridiagonal_solve (a, b, c, d, (lower, upper)) = x
> where
> gen_array f = (makeArray (lower, upper) f)
> x = gen_array x_f
> where
> x_f i
> | i == upper = (d_dash ! upper)
> | otherwise = (d_dash ! i) - (c_dash ! i)
> * (x ! (i + 1))
> d_dash = gen_array d_dash_f
> where
> d_dash_f i
> | i == lower = (d ! lower) / (b ! lower)
> | otherwise = ((d ! i) - (d_dash ! (i -
> 1)) * (a ! i)) /
> ((b ! i) - (c_dash ! (i -
> 1)) * (a ! i))
> c_dash = gen_array c_dash_f
> where
> c_dash_f i
> | i == lower = (c ! lower) / (b ! lower)
> | otherwise = (c ! i) /
> ((b ! i) - (c_dash ! (i -
> 1)) * (a ! i))
>
> When I attempt to load this into ghci, I recieve the following error:
>
> [1 of 1] Compiling Main ( main.lhs, interpreted )
>
> main.lhs:29:11:
> Could not deduce (IArray a1 e)
> from the context (IArray a3 e,
> IArray a6 e,
> IArray a7 e,
> Fractional e,
> Ix a2,
> Num a2,
> IArray a4 e,
> IArray a21 e,
> IArray a5 e,
> IArray a11 e,
> Enum a2)
> arising from a use of `gen_array' at main.lhs:29:11-28
> Possible fix:
> add (IArray a1 e) to the context of
> the type signature for `tridiagonal_solve'
> In the expression: gen_array d_dash_f
> In the definition of `d_dash':
> d_dash = gen_array d_dash_f
> where
> d_dash_f i | i == lower = (d ! lower) / (b ! lower)
> | otherwise
> = ((d ! i) - (d_dash ! (i - 1)) * (a !
> i))
> / ((b ! i) - (c_dash ! (i - 1)) * (a !
> i))
> In the definition of `tridiagonal_solve':
> tridiagonal_solve (a, b, c, d, (lower, upper))
> = x
> where
> gen_array f = (makeArray (lower,
> upper) f)
> x = gen_array x_f
> where
> x_f i | i == upper = (d_dash !
> upper)
> | otherwise
> = (d_dash ! i) -
> (c_dash ! i) * (x ! (i + 1))
> d_dash = gen_array d_dash_f
> where
> d_dash_f i | i == lower =
> (d ! lower) / (b ! lower)
> | otherwise
> = ((d ! i) -
> (d_dash ! (i - 1)) * (a ! i))
> / ((b ! i) -
> (c_dash ! (i - 1)) * (a ! i))
> c_dash = gen_array c_dash_f
> where
> c_dash_f i | i == lower =
> (c ! lower) / (b ! lower)
> | otherwise
> = (c ! i)
> / ((b ! i) -
> (c_dash ! (i - 1)) * (a ! i))
>
> main.lhs:35:11:
> Could not deduce (IArray a e)
> from the context (IArray a3 e,
> IArray a6 e,
> IArray a7 e,
> Fractional e,
> Ix a2,
> Num a2,
> IArray a4 e,
> IArray a21 e,
> IArray a5 e,
> IArray a11 e,
> Enum a2)
> arising from a use of `gen_array' at main.lhs:35:11-28
> Possible fix:
> add (IArray a e) to the context of
> the type signature for `tridiagonal_solve'
> In the expression: gen_array c_dash_f
> In the definition of `c_dash':
> c_dash = gen_array c_dash_f
> where
> c_dash_f i | i == lower = (c ! lower) / (b ! lower)
> | otherwise = (c ! i) / ((b ! i) -
> (c_dash ! (i - 1)) * (a ! i))
> In the definition of `tridiagonal_solve':
> tridiagonal_solve (a, b, c, d, (lower, upper))
> = x
> where
> gen_array f = (makeArray (lower,
> upper) f)
> x = gen_array x_f
> where
> x_f i | i == upper = (d_dash !
> upper)
> | otherwise
> = (d_dash ! i) -
> (c_dash ! i) * (x ! (i + 1))
> d_dash = gen_array d_dash_f
> where
> d_dash_f i | i == lower =
> (d ! lower) / (b ! lower)
> | otherwise
> = ((d ! i) -
> (d_dash ! (i - 1)) * (a ! i))
> / ((b ! i) -
> (c_dash ! (i - 1)) * (a ! i))
> c_dash = gen_array c_dash_f
> where
> c_dash_f i | i == lower =
> (c ! lower) / (b ! lower)
> | otherwise
> = (c ! i)
> / ((b ! i) -
> (c_dash ! (i - 1)) * (a ! i))
>
> My question is, what should the type signature for tridiagonal_solve
> actually be? I would like one that doesn't limit the generality of
> tridiagonal_solve because I would like to pass different array types
> in the one function invocation, as long as they have the same index
> and element types. I'm happy if other functions need type signatures
> as well.
>
> I'm using ghc 6.8.2 on windows, though I get a similar issue with
> ghc 6.4.1.
>
> Thanks.
>
> Clinton
> _______________________________________________
> 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