ghc6 behavior with circular instance declaration
Kenny
haskellmail at yahoo.com.sg
Wed Oct 22 13:15:00 EDT 2003
Hi all,
currently I got this program of Eq:
module Myeq where
class Myeq a where
myeq :: a -> a -> Bool
instance Myeq Int where
myeq i j = (i==j)
-- convententionally, we write:
{-
instance (Myeq a) => Myeq [a] where
myeq (x:xs) (y:ys) = (myeq x y)&&(myeq xs ys)
-}
instance (Myeq a,Myeq [a]) => Myeq [a] where
myeq (x:xs) (y:ys) = (myeq x y)&&(myeq xs ys)
I want to make the 2nd call of myeq to be of an
instance function from the context instead of a
recursive call. And obviously there is an obvious
cycle in the instances declaration.
I run it in ghc6.0.1, it is reported well-typed, but
when I run it with some arguments, I get a run-time
error.
Loading package base ... linking ... done.
Compiling Myeq ( Myeq.hs, interpreted )
Ok, modules loaded: Myeq.
*Myeq> myeq [] []
Context reduction stack overflow; size = 21
Use -fcontext-stack20 to increase stack size to (e.g.)
20
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`Myeq [a]' arising from use of `myeq' at
<interactive>:1
`myeq at [[a]]' arising from use of `myeq' at
<interactive>:1
When generalising the type(s) for `it'
There have been several similar dicussion before in
this mailing list, and in one of the thread Simon says
he could resolve this coinductive instances by adding
the current goal into the axiom set. Is that the
reason this program passed type-check? we guess if
this is true, the evidence construction of the
myeq_ListofInt becomes
myeq_ListofInt = ec myeq_Int myeq_ListofInt
when this function is applied with some argument, the
execution loops at the point when it tries to evaluate
myeq_ListofInt. Here we assume operation semantic is
call-by-value.
If the operation semantic is call-by-name, this
program will terminates.
Here I am just making a wild guess how ghc is
implemented.
Can someone verify whether this is true?
Regards,
-Kenny
__________________________________________________
Do You Yahoo!?
Faster. Easier. Bingo.
http://sg.search.yahoo.com
More information about the Haskell
mailing list