deriving Data.HashTable - stack overflow

Hi folks, In GHC 7.6.3, the base Data.HashTable is deprecated, so I installed the hashtables package. In order to work on your datatype, you need an instance of Data.Hashable.Hashable. So I went to the Data.Hashable page and looked up examples on how to derive a Hashable instance for my datatype: http://hackage.haskell.org/packages/archive/hashable/latest/doc/html/Data-Ha... The problem occurs even when using the sample code on the page: {-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic) import Data.Hashable data Colour = Red | Green | Blue deriving Generic instance Hashable Colour If I then type `hash Red` I get a stack overflow. I am using the Haskell Platform, so I have hashable-1.1.2.5, but I notice the docs are for hashable-1.2.0.10. If I install 1.2.0.10 though, other code in my project breaks - seems like one part doesn't recognize the instances from another part. So I'll stick with the platform version. I am running the 32-bit Windows GHC 7.6.3. Haskell Platform 2013.2.0.0. Any thoughts? Thanks, Lyle

On Thu, Aug 8, 2013 at 12:22 PM, Lyle Kopnicky
...
So I went to the Data.Hashable page and looked up examples on how to derive a Hashable instance for my datatype:
http://hackage.haskell.org/packages/archive/hashable/latest/doc/html/Data-Ha...
The problem occurs even when using the sample code on the page:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics (Generic) import Data.Hashable
data Colour = Red | Green | Blue deriving Generic
instance Hashable Colour
If I then type `hash Red` I get a stack overflow.
I am using the Haskell Platform, so I have hashable-1.1.2.5, but I notice the docs are for hashable-1.2.0.10. If I install 1.2.0.10 though, other code in my project breaks - seems like one part doesn't recognize the instances from another part. So I'll stick with the platform version.
...
Generic support was added in hashable-1.2. Before then, the default implementations for `hash` and `hashWithSalt` were written in terms of each other: hash = hashWithSalt defaultSalt hashWithSalt salt x = salt `combine` hash x Because you did not give an implementation for either of these, both default implementations were used, leading to a loop.

I do wish there was a compiler-checked way of specifying a minimum complete
definition.
On Thu, Aug 8, 2013 at 11:02 AM, Joey Adams
On Thu, Aug 8, 2013 at 12:22 PM, Lyle Kopnicky
wrote: ...
So I went to the Data.Hashable page and looked up examples on how to derive a Hashable instance for my datatype:
http://hackage.haskell.org/packages/archive/hashable/latest/doc/html/Data-Ha...
The problem occurs even when using the sample code on the page:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics (Generic) import Data.Hashable
data Colour = Red | Green | Blue deriving Generic
instance Hashable Colour
If I then type `hash Red` I get a stack overflow.
I am using the Haskell Platform, so I have hashable-1.1.2.5, but I notice the docs are for hashable-1.2.0.10. If I install 1.2.0.10 though, other code in my project breaks - seems like one part doesn't recognize the instances from another part. So I'll stick with the platform version.
...
Generic support was added in hashable-1.2. Before then, the default implementations for `hash` and `hashWithSalt` were written in terms of each other:
hash = hashWithSalt defaultSalt hashWithSalt salt x = salt `combine` hash x
Because you did not give an implementation for either of these, both default implementations were used, leading to a loop.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

There is a ticket with discussion and a patch here [0].
Erik
[0] http://ghc.haskell.org/trac/ghc/ticket/7633
On Thu, Aug 8, 2013 at 8:11 PM, David Thomas
I do wish there was a compiler-checked way of specifying a minimum complete definition.
On Thu, Aug 8, 2013 at 11:02 AM, Joey Adams
wrote: On Thu, Aug 8, 2013 at 12:22 PM, Lyle Kopnicky
wrote: ...
So I went to the Data.Hashable page and looked up examples on how to derive a Hashable instance for my datatype:
http://hackage.haskell.org/packages/archive/hashable/latest/doc/html/Data-Ha...
The problem occurs even when using the sample code on the page:
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics (Generic) import Data.Hashable
data Colour = Red | Green | Blue deriving Generic
instance Hashable Colour
If I then type `hash Red` I get a stack overflow.
I am using the Haskell Platform, so I have hashable-1.1.2.5, but I notice the docs are for hashable-1.2.0.10. If I install 1.2.0.10 though, other code in my project breaks - seems like one part doesn't recognize the instances from another part. So I'll stick with the platform version.
...
Generic support was added in hashable-1.2. Before then, the default implementations for `hash` and `hashWithSalt` were written in terms of each other:
hash = hashWithSalt defaultSalt hashWithSalt salt x = salt `combine` hash x
Because you did not give an implementation for either of these, both default implementations were used, leading to a loop.
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Ah, thanks, folks! I'll just implement my own hashing by generating a string and calling the hash function on that. That's what I was doing in the old version of my code, anyway. It's just that in the core Data.HashTable, you had to provide a hash function, so the point where I used the hash table was able to call a string conversion function that was defined elsewhere. With the hashtable package, you have to define a Hashable instance in the same package as your datatype definition - which is not where the string conversion is implemented. Calling the string conversion function leads to a cyclic dependency that I wanted to avoid. So I'll have to maybe move it to live with the datatype definition, or duplicate it, or use some other means of hashing. In other words, package A defines datatype A. Package B defines A -> String. Package C creates a HashTable that indexes by As, and also imports package B, so it can build a hash function as the composition of the string conversion and the provided string hashing. But now I need to define the Hashable instance in A, which doesn't have access to package B, since package B also depends on A, and I don't like circular dependencies. - Lyle

I chose not to introduce another dependency. I just implemented the hash function by delegating to the Show instance of the nested type: data ValType = FloatType | IntType | StringType deriving (Show,Eq) data VarName = VarName ValType String deriving (Show,Eq) instance Hashable VarName where hash (VarName t n) = hash (show t ++ n) Not super-efficient, but it'll be fine. The printString function (defined in that other package) uses a single character prefix for each ValType. - Lyle

Here's another way to do it: data ValType = FloatType | IntType | StringType deriving (Show,Eq) instance Hashable ValType where hash FloatType = 0 hash IntType = 1 hash StringType = 2 data VarName = VarName ValType String deriving (Show,Eq) instance Hashable VarName where hash (VarName t n) = hash (t, n)
participants (4)
-
David Thomas
-
Erik Hesselink
-
Joey Adams
-
Lyle Kopnicky