Commit f72811c4 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'move-g-hash-to-platform' into 'master'

Move gHash to Platform

Closes #433

See merge request !528
parents 4dd54089 493a9816
Pipeline #47378 passed with stages
in 10 minutes and 16 seconds
definition module iTasks.Extensions.Currency
import iTasks
from iTasks.Internal.Generic.Hash import generic gHash
from Data.GenHash import generic gHash
//* Money (ISO4217 currency codes are used)
:: EUR = EUR !Int //Euros (amount in cents)
......
implementation module iTasks.Extensions.Currency
import iTasks
import iTasks.UI.Editor.Controls, iTasks.UI.Editor.Modifiers
from iTasks.Internal.Generic.Hash import generic gHash
import Text, Data.Maybe, Data.Func, Data.Functor
from Data.GenHash import generic gHash
import qualified Data.Map as DM
//* Money (ISO4217 currency codes are used)
......
definition module iTasks.Extensions.Web
import iTasks
from iTasks.Internal.Generic.Hash import generic gHash
from Data.GenHash import generic gHash
from Internet.HTTP import :: HTTPMethod, :: HTTPRequest, :: HTTPResponse
from Text.URI import :: URI
from Text.HTML import class html
......
definition module iTasks.Internal.Generic.Hash
/**
* This module provides a generic hashing function, with the basic building
* blocks taken from MurmurHash2 (https://github.com/aappleby/smhasher).
*
* This hash is not cryptographically secure, but generates few collisions and
* is relatively fast. It can therefore be used to speed up comparisons
* (https://softwareengineering.stackexchange.com/a/145633).
*
* We use this hash to create keys for efficient `Map`s. Previously, these were
* indexed using
*
* 1. The `gText` representation. This is not secure, because when `gText` is
* specialized not all parts of the value may be taken into account. (Also
* this is very slow and requires a lot of memory to create and store the
* string representations.)
* 2. A hash of the GraphCopy representation. This can however give a different
* hash for the same value. In particular this is the case for strings: for
* example, the last 7 bytes (3 on 32-bit systems) of a string of length 1
* are unused, and unspecified in the GraphCopy representation.
*
* For this reason we now use a dedicated hashing function.
*/
import StdGeneric
from StdInt import instance * Int, IF_INT_64_OR_32, bitxor
from StdList as StdList import qualified foldl
from StdOverloaded import class toInt(..), class toString(..), class *(*), class +(+)
from Data.Either import :: Either
from Data.Error import :: MaybeError
//* Used to quickly compare keys of `SDSNotifyRequest`s and `SDSCacheKey`s.
generic gHash a :: !a -> Int
gHash{|Int|} i = murmurHash_prep i
gHash{|Char|} c = murmurHash_prep (toInt c + 1)
gHash{|Bool|} b = murmurHash_prep (if b 1 2)
gHash{|Real|} r = murmurHash (toString r) // this gives an equal hash for different binary representations of the same value
gHash{|String|} s = murmurHash s
gHash{|()|} _ = 0
gHash{|(,)|} fx fy (x,y) = murmurHash_combine2 (fx x) (fy y)
gHash{|(,,)|} fa fb fc (a,b,c) = murmurHash_combine [fa a,fb b,fc c]
gHash{|(,,,)|} fa fb fc fd (a,b,c,d) = murmurHash_combine [fa a,fb b,fc c,fd d]
gHash{|[]|} fx xs = murmurHash_combine [fx x \\ x <- xs]
gHash{|UNIT|} _ = 0
gHash{|PAIR|} fx fy (PAIR x y) = murmurHash_combine2 (fx x) (fy y)
gHash{|EITHER|} fl _ (LEFT l) = fl l
gHash{|EITHER|} _ fr (RIGHT r) = fr r
gHash{|CONS of {gcd_index}|} fx (CONS x) = murmurHash_combine2 (murmurHash_prep gcd_index) (fx x)
gHash{|OBJECT|} fx (OBJECT x) = fx x
gHash{|FIELD|} fx (FIELD x) = fx x
gHash{|RECORD|} fx (RECORD x) = fx x
derive gHash ?, Either, MaybeError
murmurHash :: !String -> Int
murmurHash_M :== IF_INT_64_OR_32 0xc6a4a7935bd1e995 0x5bd1e995
murmurHash_R :== IF_INT_64_OR_32 47 24
//* Combines a list of ints as is done in murmurHash
murmurHash_combine xs :== combine xs
where
combine [] = murmurHash_prep 3
combine [x:xs] = 'StdList'.foldl murmurHash_combine2 x xs
//* Combines two ints as is done in murmurHash
murmurHash_combine2 x y :== (x bitxor y) * murmurHash_M
//* Prepares an int for incorporation into a murmurHash
murmurHash_prep x
# x = x * murmurHash_M
# x = x bitxor (x shiftrU murmurHash_R)
:== x
//* Unsigned >>
(shiftrU) infix 7 :: !Int !Int -> Int
implementation module iTasks.Internal.Generic.Hash
import StdEnv
import StdGeneric
import Data.Either
import Data.Error
import qualified Data.Map
generic gHash a :: !a -> Int
gHash{|Int|} i = murmurHash_prep i
gHash{|Char|} c = murmurHash_prep (toInt c + 1)
gHash{|Bool|} b = murmurHash_prep (if b 1 2)
gHash{|Real|} r = murmurHash (toString r)
gHash{|String|} s = murmurHash s
gHash{|()|} _ = 0
gHash{|(,)|} fx fy (x,y) = murmurHash_combine2 (fx x) (fy y)
gHash{|(,,)|} fa fb fc (a,b,c) = murmurHash_combine [fa a,fb b,fc c]
gHash{|(,,,)|} fa fb fc fd (a,b,c,d) = murmurHash_combine [fa a,fb b,fc c,fd d]
gHash{|[]|} fx xs = murmurHash_combine [fx x \\ x <- xs]
gHash{|UNIT|} _ = 0
gHash{|PAIR|} fx fy (PAIR x y) = murmurHash_combine2 (fx x) (fy y)
gHash{|EITHER|} fl _ (LEFT l) = fl l
gHash{|EITHER|} _ fr (RIGHT r) = fr r
gHash{|CONS of {gcd_index}|} fx (CONS x) = murmurHash_combine2 (murmurHash_prep gcd_index) (fx x)
gHash{|OBJECT|} fx (OBJECT x) = fx x
gHash{|FIELD|} fx (FIELD x) = fx x
gHash{|RECORD|} fx (RECORD x) = fx x
derive gHash ?, Either, MaybeError
M :== murmurHash_M
R :== murmurHash_R
murmurHash :: !String -> Int
murmurHash s = IF_INT_64_OR_32 (murmurHash_64 s) (murmurHash_32 s)
murmurHash_64 :: !String -> Int
murmurHash_64 s
# h = seed bitxor (len*M)
# mainlen = (len>>3)<<3
# h = runblocks 0 mainlen h
# restlen = len bitand 7
# rest = get_int_from_string mainlen s
# rest = rest bitand ((1<<(restlen<<3))-1)
# h = (h bitxor rest) * M
# h = h bitxor (h shiftrU R)
# h = h * M
# h = h bitxor (h shiftrU R)
= h
where
seed = bitnot M
len = size s
runblocks :: !Int !Int !Int -> Int
runblocks i end h
| i >= end = h
# k = get_int_from_string i s
# k = k * M
# k = k bitxor (k shiftrU R)
# h = (h * M) bitxor (k * M)
= runblocks (i+8) end h
get_int_from_string :: !Int !String -> Int
get_int_from_string offset s = code inline {
push_a_b 0
pop_a 1
addI
load_i 16
}
murmurHash_32 :: !String -> Int
murmurHash_32 s
# h = seed bitxor len
# mainlen = (len>>2)<<2
# h = runblocks 0 mainlen h
# restlen = len bitand 3
# rest = get_int_from_string mainlen s
# rest = rest bitand ((1<<(restlen<<3))-1)
# h = (h bitxor rest) * M
# h = h bitxor (h shiftrU 13)
# h = h * M
# h = h bitxor (h shiftrU 15)
= h
where
seed = bitnot M
len = size s
runblocks :: !Int !Int !Int -> Int
runblocks i end h
| i >= end = h
# k = get_int_from_string i s
# k = k * M
# k = k bitxor (k shiftrU R)
# h = (h * M) bitxor (k * M)
= runblocks (i+4) end h
get_int_from_string :: !Int !String -> Int
get_int_from_string offset s = code inline {
push_a_b 0
pop_a 1
addI
load_i 8
}
(shiftrU) infix 7 :: !Int !Int -> Int
(shiftrU) _ _ = code inline {
shiftrU
}
......@@ -8,10 +8,10 @@ from Data.Map import :: Map
import qualified Data.Map as DM
import Data.Error, Data.Func, Data.Tuple, System.OS, System.Time, Text.GenJSON, Data.Foldable
import Data.Maybe
import Data.GenHash
from Data.Set import instance Foldable Set, instance < (Set a)
import qualified Data.Set as Set
import iTasks.Engine
import iTasks.Internal.Generic.Hash
import iTasks.Internal.IWorld
import iTasks.Internal.Task, iTasks.Internal.TaskState, iTasks.Internal.TaskEval
import iTasks.Internal.TaskIO
......
......@@ -5,10 +5,10 @@ definition module iTasks.SDS.Combinators.Core
import iTasks.SDS.Definition
from iTasks.Internal.IWorld import :: IWorld
from Data.Either import :: Either
from Data.GenHash import generic gHash
from Text.GenJSON import :: JSONNode
from System.Time import :: Timespec
from iTasks.Internal.Generic.Hash import generic gHash
from iTasks.WF.Definition import class iTask
from iTasks.WF.Definition import generic gEditor, generic gEq, generic gText, generic JSONEncode, generic JSONDecode
......
......@@ -10,9 +10,9 @@ from iTasks.Internal.IWorld import :: IWorld, :: ConnectionId
import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
from iTasks.Internal.Generic.Hash import generic gHash
import iTasks.UI.Editor.Generic
import Data.GenEq, Internet.HTTP, Data.Maybe.Ord
from Data.GenHash import generic gHash
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
from Data.Either import :: Either
......
......@@ -6,6 +6,7 @@ import Data.GenEq
import Data.Either
import Data.Error
import Data.Func
import Data.GenHash
import Data.List
import Data.Maybe
import Internet.HTTP
......@@ -19,7 +20,6 @@ import iTasks.Internal.Util
import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
import iTasks.Internal.Generic.Hash
import iTasks.UI.Editor.Generic
import iTasks.WF.Derives
......
......@@ -5,8 +5,8 @@ definition module iTasks.SDS.Sources.Core
import iTasks.SDS.Definition
from System.FilePath import :: FilePath
from Data.Error import :: MaybeError, :: MaybeErrorString
from Data.GenHash import generic gHash
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from iTasks.Internal.Generic.Hash import generic gHash
// constant share from which you always read the same value
constShare :: !a -> SDSSource p a () | gHash{|*|} p
......
......@@ -5,9 +5,9 @@ definition module iTasks.SDS.Sources.Store
*/
import iTasks.SDS.Definition
from Data.GenHash import generic gHash
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from System.FilePath import :: FilePath
from iTasks.Internal.Generic.Hash import generic gHash
:: StoreNamespace :== String
:: StoreName :== String
......
......@@ -4,7 +4,6 @@ definition module iTasks.WF.Derives
* such that you don't have to derive them when you use these libraries.
*/
import iTasks.WF.Definition
from iTasks.Internal.Generic.Hash import generic gHash
from iTasks.WF.Combinators.Core import :: Action, :: TaskListItem, :: TaskListFilter, :: AttachmentStatus
from iTasks.Internal.IWorld import :: ClockParameter
......@@ -12,6 +11,7 @@ from iTasks.Internal.TaskState import :: TaskChange, :: ExtendedTaskListFilter
from iTasks.SDS.Sources.System import :: TaskInstance, :: ValueStatus
import Data.Either.GenJSON, Data.Error.GenJSON, Data.Map.GenJSON
from Data.GenHash import generic gHash
from Data.Map import :: Map
from Data.Set import :: Set
import Text.HTML.GenJSON
......
implementation module iTasks.WF.Derives
import iTasks.Internal.Generic.Hash
import iTasks.Internal.TaskState
import iTasks.WF.Definition
import iTasks.WF.Combinators.Core
......@@ -12,6 +11,7 @@ import Data.Either
import Data.Error
import Data.Func
import Data.Functor
import Data.GenHash
import qualified Data.Map as Map
import Data.Map.GenJSON
import Data.Maybe
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment