Merge pull request #5884 from unisonweb/topic/direct-murmur

Implement a direct murmur hash on values that omits type references

Author: pchiusano

lib/unison-util-bytes/package.yaml

@@ -17,6 +17,7 @@ library:
     - bytestring-to-vector
     - deepseq
     - memory
+    - murmur-hash
     - primitive
     - stringsearch
     - text

lib/unison-util-bytes/src/Unison/Util/Bytes.hs

@@ -53,6 +53,7 @@ module Unison.Util.Bytes
     zlibDecompress,
     gzipCompress,
     gzipDecompress,
+    hash64AddBytes,
   )
 where
 
@@ -68,6 +69,7 @@ import Data.ByteString qualified as B
 import Data.ByteString.Lazy qualified as LB
 import Data.ByteString.Lazy.Search qualified as SS
 import Data.Char
+import Data.Digest.Murmur64 (Hash64, hash64AddInt)
 import Data.Primitive.ByteArray
   ( ByteArray (ByteArray),
     copyByteArrayToPtr,
@@ -418,5 +420,12 @@ toWord8s bs = chunks bs >>= V.toList
 fromWord8s :: [Word8] -> Bytes
 fromWord8s bs = snoc empty (V.fromList bs)
 
+-- Adds the bytes of the value to a hash. This does not depend on the
+-- chunking or splitting of the bytes values, just on the bytes.
+hash64AddBytes :: Bytes -> Hash64 -> Hash64
+hash64AddBytes bs h = foldl' addChunk h $ underlying bs
+  where
+    addChunk = V.foldl' (\h b -> hash64AddInt (fromIntegral b) h)
+
 instance Show Bytes where
   show bs = toWord8s (toBase16 bs) >>= \w -> [chr (fromIntegral w)]

lib/unison-util-bytes/unison-util-bytes.cabal

@@ -58,6 +58,7 @@ library
     , bytestring-to-vector
     , deepseq
     , memory
+    , murmur-hash
     , primitive
     , stringsearch
     , text

parser-typechecker/package.yaml

@@ -32,6 +32,7 @@ library:
     - megaparsec
     - mmorph
     - mtl
+    - murmur-hash
     - mutable-containers
     - network-uri
     - nonempty-containers

parser-typechecker/src/Unison/Builtin.hs

@@ -486,6 +486,7 @@ builtinsSrc =
     B "Universal.>=" $ forall1 "a" (\a -> a --> a --> boolean),
     B "Universal.<=" $ forall1 "a" (\a -> a --> a --> boolean),
     B "Universal.murmurHash" $ forall1 "a" (\a -> a --> nat),
+    B "Universal.murmurHashUntyped" $ forall1 "a" (\a -> a --> nat),
     B "bug" $ forall1 "a" (\a -> forall1 "b" (\b -> a --> b)),
     B "todo" $ forall1 "a" (\a -> forall1 "b" (\b -> a --> b)),
     B "Any.Any" $ forall1 "a" (\a -> a --> anyt),

parser-typechecker/src/Unison/Util/EnumContainers.hs

@@ -22,6 +22,7 @@ module Unison.Util.EnumContainers
     lookupWithDefault,
     mapWithKey,
     foldMapWithKey,
+    foldlWithKey,
     mapToList,
     (!),
     findMin,
@@ -171,6 +172,11 @@ mapWithKey f (EM m) = EM $ IM.mapWithKey (f . intToKey) m
 foldMapWithKey :: (EnumKey k) => (Monoid m) => (k -> a -> m) -> EnumMap k a -> m
 foldMapWithKey f (EM m) = IM.foldMapWithKey (f . intToKey) m
 
+{-# INLINE foldlWithKey #-}
+foldlWithKey :: (EnumKey k) => (r -> k -> a -> r) -> r -> EnumMap k a -> r
+foldlWithKey f z (EM m) =
+  IM.foldlWithKey' (\r k x -> f r (intToKey k) x) z m
+
 {-# INLINE mapToList #-}
 mapToList :: (EnumKey k) => EnumMap k a -> [(k, a)]
 mapToList (EM m) = first intToKey <$> IM.toList m

parser-typechecker/src/Unison/Util/Text.hs

@@ -4,6 +4,7 @@
 
 module Unison.Util.Text where
 
+import Data.Digest.Murmur64 (Hash64, Hashable64 (..))
 import Data.Foldable (toList)
 import Data.List (foldl', unfoldr)
 import Data.List qualified as L
@@ -184,6 +185,15 @@ dropWhileMax p = go 0
       | otherwise = (total, empty)
 {-# INLINE dropWhileMax #-}
 
+-- Adds the codepoints of the Text into a murmur hash. This depends only
+-- on the characters, so adding texts chunked in different ways, or
+-- multiple texts that would concatenate to the same text will give the
+-- same result.
+hash64AddText :: Text -> Hash64 -> Hash64
+hash64AddText (Text tx) h = foldl' addChunk h tx
+  where
+    addChunk h (Chunk _ tx) = T.foldl' (flip hash64Add) h tx
+
 instance Eq Chunk where (Chunk n a) == (Chunk n2 a2) = n == n2 && a == a2
 
 instance Ord Chunk where (Chunk _ a) `compare` (Chunk _ a2) = compare a a2

parser-typechecker/unison-parser-typechecker.cabal

@@ -214,6 +214,7 @@ library
     , megaparsec
     , mmorph
     , mtl
+    , murmur-hash
     , mutable-containers
     , network-uri
     , nonempty-containers

unison-runtime/src/Unison/Runtime/ANF.hs

@@ -119,6 +119,7 @@ import Unison.Prelude
 import Unison.PrettyPrintEnv (PrettyPrintEnv, termName)
 import Unison.Reference (Id, Reference, Reference' (Builtin, DerivedId), toShortHash)
 import Unison.ReferentPrime qualified as Rfn
+import Unison.Runtime.ANF.POp (POp (..))
 import Unison.Runtime.Array qualified as PA
 import Unison.Runtime.Foreign.Function.Type (ForeignFunc (..))
 import Unison.Runtime.InternalError (internalBug)
@@ -1468,176 +1469,6 @@ litRef (C _) = Ty.charRef
 litRef (LM _) = Ty.termLinkRef
 litRef (LY _) = Ty.typeLinkRef
 
--- Note: Enum/Bounded instances should only be used for things like
--- getting a list of all ops. Using auto-generated numberings for
--- serialization, for instance, could cause observable changes to
--- formats that we want to control and version.
-data POp
-  = -- Int
-    ADDI -- +
-  | SUBI -- -
-  | MULI
-  | DIVI -- /
-  | SGNI -- sgn
-  | NEGI -- neg
-  | MODI -- mod
-  | POWI -- pow
-  | SHLI -- shiftl
-  | SHRI -- shiftr
-  | ANDI -- and
-  | IORI -- or
-  | XORI -- xor
-  | COMI -- complement
-  | INCI -- inc
-  | DECI -- dec
-  | LEQI -- <=
-  | LESI -- <
-  | EQLI -- ==
-  | NEQI -- !=
-  | TRNC -- truncate0
-  -- Nat
-  | ADDN -- +
-  | SUBN -- -
-  | DRPN -- drop
-  | MULN
-  | DIVN -- /
-  | MODN -- mod
-  | TZRO -- trailingZeros
-  | LZRO -- leadingZeros
-  | POPC -- popCount
-  | POWN -- pow
-  | SHLN -- shiftl
-  | SHRN -- shiftr
-  | ANDN -- and
-  | IORN -- or
-  | XORN -- xor
-  | COMN -- complement
-  | INCN -- inc
-  | DECN -- dec
-  | LEQN -- <=
-  | LESN -- <
-  | EQLN -- ==
-  | NEQN -- !=
-  -- Float
-  | ADDF -- +
-  | SUBF -- -
-  | MULF
-  | DIVF -- /
-  | MINF -- min
-  | MAXF -- max
-  | LEQF -- <=
-  | LESF -- <
-  | EQLF -- ==
-  | NEQF -- !=
-  | POWF -- pow
-  | EXPF -- exp
-  | SQRT -- sqrt
-  | LOGF -- log
-  | LOGB -- logBase
-  | ABSF -- abs
-  | CEIL -- ceil
-  | FLOR -- floor
-  | TRNF -- truncate
-  | RNDF -- round
-  -- Trig
-  | COSF -- cos
-  | ACOS -- acos
-  | COSH -- cosh
-  | ACSH -- acosh
-  | SINF -- sin
-  | ASIN -- asin
-  | SINH -- sinh
-  | ASNH -- asinh
-  | TANF -- tan
-  | ATAN -- atan
-  | TANH -- tanh
-  | ATNH -- atanh
-  | ATN2 -- atan2
-  -- Text
-  | CATT -- ++
-  | TAKT -- take
-  | DRPT -- drop
-  | SIZT -- size
-  | IXOT -- indexOf
-  | UCNS -- uncons
-  | USNC -- unsnoc
-  | EQLT -- ==
-  | LEQT -- <=
-  | PAKT -- pack
-  | UPKT -- unpack
-  -- Sequence
-  | CATS -- ++
-  | TAKS -- take
-  | DRPS -- drop
-  | SIZS -- size
-  | CONS -- cons
-  | SNOC -- snoc
-  | IDXS -- at
-  | BLDS -- build
-  | VWLS -- viewl
-  | VWRS -- viewr
-  | SPLL -- splitl
-  | SPLR -- splitr
-  -- Bytes
-  | PAKB -- pack
-  | UPKB -- unpack
-  | TAKB -- take
-  | DRPB -- drop
-  | IXOB -- indexOf
-  | IDXB -- index
-  | SIZB -- size
-  | FLTB -- flatten
-  | CATB -- append
-  -- Conversion
-  | ITOF -- intToFloat
-  | NTOF -- natToFloat
-  | ITOT -- intToText
-  | NTOT -- natToText
-  | TTOI -- textToInt
-  | TTON -- textToNat
-  | TTOF -- textToFloat
-  | FTOT -- floatToText
-  | CAST -- runtime type cast for unboxed values.
-  | -- Concurrency
-    FORK -- fork
-  | -- Universal operations
-    EQLU -- ==
-  | CMPU -- compare
-  | LEQU -- <=
-  | LESU -- <
-  | EROR -- error
-  | -- Code
-    MISS -- isMissing
-  | CACH -- cache_
-  | LKUP -- lookup
-  | LOAD -- load
-  | CVLD -- validate
-  | SDBX -- sandbox
-  | VALU -- value
-  | TLTT -- Term.Link.toText
-  -- Debug
-  | PRNT -- print
-  | INFO -- info
-  | TRCE -- trace
-  | DBTX -- debugText
-  | -- STM
-    ATOM -- atomically
-  | TFRC -- try force
-  | SDBL -- sandbox link list
-  | SDBV -- sandbox check for Values
-  -- Refs
-  | REFN -- Ref.new
-  | REFR -- Ref.read
-  | REFW -- Ref.write
-  | RCAS -- Ref.cas
-  | RRFC -- Ref.readForCas
-  | TIKR -- Ref.Ticket.read
-  -- Bools
-  | NOTB -- not
-  | ANDB -- and
-  | IORB -- or
-  deriving (Show, Eq, Ord, Enum, Bounded)
-
 type ANormal ref = ABTN.Term (ANormalF ref)
 
 type Cte v = CTE v (ANormal Reference v)