Hashable type class

src/Data/Hashable.js

@@ -0,0 +1,42 @@
+"use strict";
+
+// Same as immutable.js, except for not dropping the highest bit.
+exports.hashNumber = function (f) {
+  var o = f;
+  if (o !== o || o === Infinity) {
+    return 0;
+  }
+  var h = o | 0;
+  if (h !== o) {
+    h ^= o * 0xffffffff;
+  }
+  while (o > 0xffffffff) {
+    o /= 0xffffffff;
+    h ^= o;
+  }
+  return h;
+};
+
+// Same as Java. Improvements welcome.
+exports.hashString = function (s) {
+  var h = 0;
+  for (var i = 0; i < s.length; i++) {
+    h = (31 * h + s.charCodeAt(i)) | 0;
+  }
+  return h;
+};
+
+// Almost the same as Java. Improvements welcome.
+exports.hashArray = function (hash) {
+  return function (as) {
+    var h = as.length;
+    for (var i = 0; i < as.length; i++) {
+      h = (31 * h + hash(as[i])) | 0;
+    }
+    return h;
+  };
+};
+
+exports.hashChar = function (c) {
+  return c.charCodeAt(0);
+};

src/Data/Hashable.purs

@@ -0,0 +1,118 @@
+module Data.Hashable (
+  class Hashable,
+  hash,
+
+  class HashableRecord,
+  hashRecord,
+
+  Hash(Hash)
+) where
+
+import Data.Eq (class Eq, class EqRecord)
+import Data.Ord (class Ord)
+import Data.Ordering (Ordering(..))
+import Data.Ring (negate)
+import Data.Semigroup ((<>))
+import Data.Semiring ((*), (+))
+import Data.Show (class Show, show)
+import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
+import Data.Unit (Unit)
+import Data.Void (Void)
+import Prim.Row as Row
+import Prim.RowList (class RowToList, Cons, Nil, kind RowList)
+import Record.Unsafe (unsafeGet)
+import Type.Data.RowList (RLProxy(..))
+
+-- | The `Hashable` type class represents types with decidable
+-- | equality and a hash function whose result can approximate
+-- | equality for use in hash-based algorithms and data structures.
+-- |
+-- | Instances of `Hashable` must satisfy the following law:
+-- |
+-- | ```PureScript
+-- | (a == b) `implies` (hash a == hash b)
+-- | ```
+-- |
+-- | That is, unequal hash values are a safe approximation of
+-- | inequality. In other words, two objects whose hash values differ,
+-- | are never equal. The reverse is not necessarily true.
+-- |
+-- | Hash values produced by `hash` must not be relied upon to be
+-- | stable across multiple executions of a program and should not be
+-- | stored externally.
+class Eq a <= Hashable a where
+  hash :: a -> Hash a
+
+-- | The `Hash a` newtype wraps the hash code of a value of type `a`.
+-- |
+-- | Hash values should not be stored externally, as they must not be
+-- | relied upon to be stable across multiple executions of a
+-- | program.
+newtype Hash a = Hash Int
+
+instance showHash :: Show (Hash a) where
+  show (Hash n) = "(Hash " <> show n <> ")"
+derive newtype instance eqHash :: Eq (Hash a)
+derive newtype instance ordHash :: Ord (Hash a)
+
+instance hashableBoolean :: Hashable Boolean where
+  hash b = if b then Hash 1 else Hash 0
+
+instance hashableInt :: Hashable Int where
+  hash n = Hash n
+
+foreign import hashNumber :: Number -> Hash Number
+
+instance hashableNumber :: Hashable Number where
+  hash = hashNumber
+
+foreign import hashChar :: Char -> Hash Char
+
+instance hashableChar :: Hashable Char where
+  hash = hashChar
+
+foreign import hashString :: String -> Hash String
+
+instance hashableString :: Hashable String where
+  hash = hashString
+
+foreign import hashArray :: forall a. (a -> Hash a) -> Array a -> Hash (Array a)
+
+instance hashableArray :: Hashable a => Hashable (Array a) where
+  hash = hashArray hash
+
+instance hashableUnit :: Hashable Unit where
+  hash _ = Hash 1
+
+instance hashableVoid :: Hashable Void where
+  hash _ = Hash 0
+
+instance hashableOrdering :: Hashable Ordering where
+  hash LT = Hash (-1)
+  hash GT = Hash 1
+  hash EQ = Hash 0
+
+class EqRecord l r <= HashableRecord l r | l -> r where
+  hashRecord :: RLProxy l -> Record r -> Hash (Record r)
+
+instance hashableRecordNil :: HashableRecord Nil r where
+  hashRecord _ _ = Hash 0
+
+instance hashableRecordCons ::
+  ( Hashable vt
+  , HashableRecord tl r
+  , IsSymbol l
+  , Row.Cons l vt whatev r
+  ) => HashableRecord (Cons l vt tl) r where
+  hashRecord rlp record =
+    let (Hash rHash) = hashRecord (RLProxy :: RLProxy tl) record
+        field :: vt
+        field = unsafeGet (reflectSymbol (SProxy :: SProxy l)) record
+        (Hash fHash) = hash field
+    -- this mimics Java's hash function for arrays
+    in Hash (rHash * 31 + fHash)
+
+instance hashableRecord ::
+  (RowToList r l, HashableRecord l r, EqRecord l r)
+  => Hashable (Record r) where
+  hash = hashRecord (RLProxy :: RLProxy l)

src/Prelude.purs

@@ -15,6 +15,7 @@ module Prelude
   , module Data.Field
   , module Data.Function
   , module Data.Functor
+  , module Data.Hashable
   , module Data.HeytingAlgebra
   , module Data.Monoid
   , module Data.NaturalTransformation
@@ -45,6 +46,7 @@ import Data.EuclideanRing (class EuclideanRing, degree, div, mod, (/), gcd, lcm)
 import Data.Field (class Field)
 import Data.Function (const, flip, ($), (#))
 import Data.Functor (class Functor, flap, map, void, ($>), (<#>), (<$), (<$>), (<@>))
+import Data.Hashable (class Hashable, Hash(..), hash)
 import Data.HeytingAlgebra (class HeytingAlgebra, conj, disj, not, (&&), (||))
 import Data.Monoid (class Monoid, mempty)
 import Data.NaturalTransformation (type (~>))

test/Test/Main.purs

@@ -3,6 +3,7 @@ module Test.Main where
 import Prelude
 import Data.HeytingAlgebra (ff, tt, implies)
 import Data.Ord (abs)
+import Data.Hashable (hash)
 
 type AlmostEff = Unit -> Unit
 
@@ -120,6 +121,7 @@ testIntDegree = do
 testRecordInstances :: AlmostEff
 testRecordInstances = do
   assert "Record equality" $ { a: 1 } == { a: 1 }
+  assert "Record hash" $ hash { a: 1 } == hash { a: 1 }
   assert "Record inequality" $ { a: 2 } /= { a: 1 }
   assert "Record show" $ show { a: 1 } == "{ a: 1 }"
   assert "Record +" $ ({ a: 1, b: 2.0 } + { a: 0, b: (-2.0) }) == { a: 1, b: 0.0 }