
Hi everybody! I have just released a handy package on Hackage that will interest you if you've ever used unordered-containers with a custom type. In order to do such a thing, you'd need to define an instance of Hashable. This process could easily be automated. And so I did. {-# LANGUAGE DeriveGeneric #-} module ThisIsPrettyNeat where import Data.Hashable.Generic import GHC.Generics data MyCoolType a = MCT0 | MCT1 (Either Int a) | MCT2 (MyCoolType a) (MyCoolType a) deriving Generic instance Hashable a => Hashable MyCoolType where hashWithSalt s x = gHashWithSalt s x {-# INLINEABLE hashWithSalt #-} and voila. You have a very performant instance of Hashable, with minimal boilerplate, no template haskell, and no subtle bugs. If you want to play with it, here it is: http://hackage.haskell.org/package/hashable-generics-1.1.6 Have fun! - Clark Oh yeah, and if anyone wants to help me figure out why it's 1.3x slower than my hand-rolled instances, that would be really helpful.

Clark Gaebel
Oh yeah, and if anyone wants to help me figure out why it's 1.3x slower than my hand-rolled instances, that would be really helpful.
[...] I've taken a look at the bench/Bench.hs benchmark[1]: The generated Core looks almost[2] the same as your 'HandRolled'; but the 1.3x slow-down factor seems to be caused by the way the 'bigGenericRolledDS' CAF is defined in the test-harness: if I define it explicitly (i.e. just as 'bigHandRolledDS' is defined, and not as an isomorphic transformation of the 'bigHandRolledDS' value) the benchmark results in both versions having more or less equal performance as would be expected. [1]: https://github.com/wowus/hashable-generics/blob/master/bench/Bench.hs [2]: with the following change, it would look exactly the same (modulo alpha renamings): --8<---------------cut here---------------start------------->8--- --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -18,7 +18,7 @@ data GenericRolled = GR0 deriving Generic instance Hashable HandRolled where - hashWithSalt salt HR0 = hashWithSalt salt $ (Left () :: Either () ()) + hashWithSalt salt HR0 = hashWithSalt salt $ () hashWithSalt salt (HR1 mi) = hashWithSalt salt $ (Right $ Left mi :: Either () (Either (Maybe Int) ())) hashWithSalt salt (HR2 x y) = hashWithSalt salt $ (Right $ Right (x, y) :: Either () (Either () (HandRolled, HandRolled))) --8<---------------cut here---------------end--------------->8--- hth, hvr

Thanks a lot!
I've updated the benchmark accordingly, and have released a new version
without the 1.3x slowdown disclaimer as generic-hashable 1.1.8.
- Clark
On Sun, Nov 4, 2012 at 10:25 AM, Herbert Valerio Riedel
Clark Gaebel
writes: [...]
Oh yeah, and if anyone wants to help me figure out why it's 1.3x slower than my hand-rolled instances, that would be really helpful.
[...]
I've taken a look at the bench/Bench.hs benchmark[1]:
The generated Core looks almost[2] the same as your 'HandRolled'; but the 1.3x slow-down factor seems to be caused by the way the 'bigGenericRolledDS' CAF is defined in the test-harness: if I define it explicitly (i.e. just as 'bigHandRolledDS' is defined, and not as an isomorphic transformation of the 'bigHandRolledDS' value) the benchmark results in both versions having more or less equal performance as would be expected.
[1]: https://github.com/wowus/hashable-generics/blob/master/bench/Bench.hs
[2]: with the following change, it would look exactly the same (modulo alpha renamings):
--8<---------------cut here---------------start------------->8--- --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -18,7 +18,7 @@ data GenericRolled = GR0 deriving Generic
instance Hashable HandRolled where - hashWithSalt salt HR0 = hashWithSalt salt $ (Left () :: Either () ()) + hashWithSalt salt HR0 = hashWithSalt salt $ () hashWithSalt salt (HR1 mi) = hashWithSalt salt $ (Right $ Left mi :: Either () (Either (Maybe Int) ())) hashWithSalt salt (HR2 x y) = hashWithSalt salt $ (Right $ Right (x, y) :: Either () (Either () (HandRolled, HandRolled))) --8<---------------cut here---------------end--------------->8---
hth, hvr
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Have you talked with upstream about possibly adding this to hashable proper, using DefaultSignatures? CPP can be used to make it portable to older GHC versions.

@dag: I would love for this to be merged into Data.Hashable, and I think it would make a lot of people's lives easier, and prevent them from writing bad hash functions accidentally. - Clark On Sun, Nov 4, 2012 at 10:30 AM, dag.odenhall@gmail.com < dag.odenhall@gmail.com> wrote:
Have you talked with upstream about possibly adding this to hashable proper, using DefaultSignatures? CPP can be used to make it portable to older GHC versions.

On Sun, Nov 4, 2012 at 8:35 AM, Clark Gaebel
@dag:
I would love for this to be merged into Data.Hashable, and I think it would make a lot of people's lives easier, and prevent them from writing bad hash functions accidentally.
Couldn't we do it using GHC's default implementations based on signatures features, so we don't have to expose any new things in the API? We used that in unordered-containers like so: #ifdef GENERICS default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a parseRecord r = to <$> gparseRecord r #endif -- Johan

On Sun, Nov 4, 2012 at 5:39 PM, Johan Tibell
Couldn't we do it using GHC's default implementations based on signatures features, so we don't have to expose any new things in the API?
We used that in unordered-containers like so:
#ifdef GENERICS default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a parseRecord r = to <$> gparseRecord r #endif
Exactly, that's what I meant with DefaultSignatures. (I see that someone CC'd you here so maybe you missed the thread on cafe.)

Yes. Sorry if I wasn't clear. That's what I intended.
So would a patch adding this to hashable be accepted?
- Clark
On Sun, Nov 4, 2012 at 11:39 AM, Johan Tibell
On Sun, Nov 4, 2012 at 8:35 AM, Clark Gaebel
wrote: @dag:
I would love for this to be merged into Data.Hashable, and I think it
would make a lot of people's lives easier, and prevent them from writing bad hash functions accidentally.
Couldn't we do it using GHC's default implementations based on signatures features, so we don't have to expose any new things in the API?
We used that in unordered-containers like so:
#ifdef GENERICS default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a parseRecord r = to <$> gparseRecord r #endif
-- Johan

Clark Gaebel
@dag:
I would love for this to be merged into Data.Hashable, and I think it would make a lot of people's lives easier, and prevent them from writing bad hash functions accidentally.
Jfyi, a discussion came up when I posted a proposal to add a generics-based NFData deriver to the 'deepseq' package, with the result that the generics-based code was put in the separate `deepseq-generics` package: http://comments.gmane.org/gmane.comp.lang.haskell.libraries/17940 ...and since there's plan (iirc) to bring the 'hashable' package into the haskell-platform, some of the arguments brought up in that thread with respect to the 'deepseq' package might apply here as well. cheers, hvr

How would the ghc-dependance affect hashable's inclusion in the haskell
platform? Doesn't the haskell platform ship only a recent version of ghc
(i.e. one with support for generics)?
- Clark
On Nov 4, 2012 6:00 PM, "Herbert Valerio Riedel"
Clark Gaebel
writes: @dag:
I would love for this to be merged into Data.Hashable, and I think it would make a lot of people's lives easier, and prevent them from writing bad hash functions accidentally.
Jfyi, a discussion came up when I posted a proposal to add a generics-based NFData deriver to the 'deepseq' package, with the result that the generics-based code was put in the separate `deepseq-generics` package:
http://comments.gmane.org/gmane.comp.lang.haskell.libraries/17940
...and since there's plan (iirc) to bring the 'hashable' package into the haskell-platform, some of the arguments brought up in that thread with respect to the 'deepseq' package might apply here as well.
cheers, hvr

Clark Gaebel
How would the ghc-dependance affect hashable's inclusion in the haskell platform? Doesn't the haskell platform ship only a recent version of ghc (i.e. one with support for generics)?
I was under the impression that the haskell platform, albeit currently bundling GHC, aims for portability, as in [1] its required that a package | * Compile on all operating systems and compilers that the platform targets. [rationale-8.4] and in [2] there's a (somewhat weaker) mention of portability as well: | *Portability*. Good code is portable. In particular, try to ensure the | code runs in Hugs and GHC, and on Windows and Linux. Maybe Hugs is a bit too outdated/unmaintained, but on the other hand maybe JHC and UHC compatibility should be aimed for instead these days for core packages? [1]: http://trac.haskell.org/haskell-platform/wiki/AddingPackages#Packagerequirem... [2]: http://www.haskell.org/haskellwiki/Library_submissions#Guidance_for_proposer...

For the merge into Hashable, the default instance is only included if we're
on a compatible GHC. This means Hashable itself will be portable, but it
strongly encourages other packages not to be.
I think the portability requirement is just used as an easy way to filter
out lower quality code, anyway.
- Clark
On Tue, Nov 6, 2012 at 6:31 AM, Herbert Valerio Riedel
Clark Gaebel
writes: How would the ghc-dependance affect hashable's inclusion in the haskell platform? Doesn't the haskell platform ship only a recent version of ghc (i.e. one with support for generics)?
I was under the impression that the haskell platform, albeit currently bundling GHC, aims for portability, as in [1] its required that a package
| * Compile on all operating systems and compilers that the platform targets. [rationale-8.4]
and in [2] there's a (somewhat weaker) mention of portability as well:
| *Portability*. Good code is portable. In particular, try to ensure the | code runs in Hugs and GHC, and on Windows and Linux.
Maybe Hugs is a bit too outdated/unmaintained, but on the other hand maybe JHC and UHC compatibility should be aimed for instead these days for core packages?
[1]: http://trac.haskell.org/haskell-platform/wiki/AddingPackages#Packagerequirem... [2]: http://www.haskell.org/haskellwiki/Library_submissions#Guidance_for_proposer...

Clark Gaebel
For the merge into Hashable, the default instance is only included if we're on a compatible GHC.
I originally tried to make the same argument for enhancing `deepseq`, but I was made aware this would lead to a conditional API, which is frowned upon, or to quote a succinct summary of the `deepseq`-thread: | [...] the conclusion is that we don't want to modify the deepseq | package because that would take it outside Haskell 98, and we don't | want to have a conditional API (quite rightly). | | There's no disadvantage to having the generic functionality in a | separate package, right? So what's different with `hashable`, that the arguments that applied to `deepseq` back then shouldn't apply to `hashable` now?
This means Hashable itself will be portable, but it strongly encourages other packages not to be.
What do you mean by "encouraging other packages not to be"? Does this mean, a package depending on hashable will most likely be non-portable (due to the conditional API)?
I think the portability requirement is just used as an easy way to filter out lower quality code, anyway.
I'm not sure I follow... cheers, hvr

Your first link says that any library in the Haskell Platform must be supported on all operating systems and compilers supported by the Haskell Platform. Right now, the platform only supports GHC, and on Windows, Linux, and Mac. This change does not break any of those. I say this because if someone tries to file a ticket for the haskell platform saying it doesn't work on Hugs (for example), that ticket will be immediately closed as WontFix. The second link you mentioned was for GHC core libraries. I'm not sure about Johan's intentions, but I wouldn't expect Hashable to become a core library. As for the difference between deepseq and Hashable - there's very little as far as I know, except for different maintainers. Johan has expressed interest in getting the changes merged, so I prepared a pull request for him. When I say "encouraging other packages not be to portable", you were absolutely right in your assumption that I meant that a package depending on Hashasble will more likely be non-portable because of the conditional API. Sorry that I wasn't clear on that. And the portability requirement didn't even seem like a hard rule. It just looked like it was trying to say that good code tends to be portable. I'm not sure if the author intended to say that *all* good code is portable. - Clark

On Tue, Nov 6, 2012 at 3:32 PM, Herbert Valerio Riedel
Clark Gaebel
writes: | There's no disadvantage to having the generic functionality in a | separate package, right?
Well for one it means you can't simply write instance Class Type but must write instance Class Type where forEveryMethod = genericForEveryMethod ... and it wouldn't work with the planned generics feature that you could just write data Type deriving Class I for one think conditional APIs are all OK; a form of "progressive enhancement".

A note: if you use generic-deriving instead of ghc-prim, the generics code could in theory be portable as well. That package re-exports from ghc-prim when compiled with GHC, and provides a compatible fallback implementation.

Also: Platform includes QuickCheck which has a conditional API for TemplateHaskell support. I wouldn't be surprised if there are more examples like that.
participants (4)
-
Clark Gaebel
-
dag.odenhall@gmail.com
-
Herbert Valerio Riedel
-
Johan Tibell