5b1e1fec1fa1 — Leonard Ritter a month ago
* added hash stack functions
4 files changed, 191 insertions(+), 5 deletions(-)

M lib/tukan/hash.sc
A => testing/cofrac.sc
M testing/scrambleint.sc
A => testing/test_hashstack.sc
M lib/tukan/hash.sc +60 -4
@@ 15,6 15,43 @@ fn... wang-hash (seed : u32,)
     seed := seed * 0x27d4eb2d:u32
     seed ^ (seed >> 15:u32)
 
+fn... murmurhash32_mix32 (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x85ebca6b:u32
+    x := x ^ (x >> 13)
+    x := x * 0xc2b2ae35:u32
+    x := x ^ (x >> 16)
+    x
+
+# from https://nullprogram.com/blog/2018/07/31/
+fn... lowbias32 (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x7feb352d:u32
+    x := x ^ (x >> 15)
+    x := x * 0x846ca68b:u32
+    x := x ^ (x >> 16)
+    x
+
+# inverse
+fn... lowbias32_r (x : u32)
+    x := x ^ (x >> 16)
+    x := x * 0x43021123:u32
+    x := x ^ (x >> 15 ^ x >> 30)
+    x := x * 0x1d69e2a5:u32
+    x := x ^ (x >> 16)
+    x
+
+# // exact bias: 0.020888578919738908
+fn... triple32 (x : u32)
+    x := x ^ (x >> 17)
+    x := x * 0xed5ad4bb:u32
+    x := x ^ (x >> 11)
+    x := x * 0xac4c1b51:u32
+    x := x ^ (x >> 15)
+    x := x * 0x31848bab:u32
+    x := x ^ (x >> 14)
+    x
+
 fn fract (x)
     x % 1.0
 

          
@@ 80,11 117,30 @@ fn vec3hashuv (p)
     "vec3 <- (f32)"
     vec3hashf (vec3 p) NHASHSCALE
 
-#if main-module?
-    print
-        hash3 (vec3 1 2 3)
+################################################################################
+
+#inline... mod_inverse_2 (a : u64)
+    x := (a * a) + a - 1:u64 # 4
+    x := x * (2:u64 - a * x) # 8
+    x := x * (2:u64 - a * x) # 16
+    x := x * (2:u64 - a * x) # 32
+    x := x * (2:u64 - a * x) # 64
+    x
+
+let MAGIC = 0x66d6cf4cc5ddd26d:u64
+let MAGIC^-1 = 0x24ffe0c7fcc70765:u64 #(mod_inverse_2 magic)
+
+inline... hpush (a : u64, b : u64)
+    # both arguments must be hashes
+    (MAGIC * a) ^ b
+
+inline... hpop (a : u64, b : u64)
+    # both arguments must be hashes; `a` must be the result of hpush(a,b)
+    MAGIC^-1 * (a ^ b)
+
+################################################################################
 
 do
     let f32hash f32hashuv vec2hash vec2hashuv vec3hash vec3hashuv
-    let wang-hash
+    let wang-hash hpush hpop
     locals;

          
A => testing/cofrac.sc +41 -0
@@ 0,0 1,41 @@ 
+# continued fractions
+
+#
+    a / b
+
+    (n * a + b) / a
+
+inline fold (s seq...)
+    s as:= i64
+    call
+        va-lfold (inline () (_ s 1:i64))
+            inline (k v f)
+                let a b = (f)
+                inline ()
+                    _ (a * (v as i64) + b) a
+            seq...
+
+let a b =
+    fold 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    #fold 2 8 1 1 1 11 2 7 0
+let q = (a as f64 / b)
+print a "/" b "=" q
+
+inline unfold (n c)
+    n as:= f64
+    let n seq... =
+        call
+            va-lfold (inline () n)
+                inline (k v f)
+                    let n seq... = (f)
+                    let r = (n % 1.0:f64)
+                    let I = (n as i64)
+                    inline ()
+                        _ (/ r) I seq...
+                va-range c
+    seq...
+
+print
+    unfold q 20
+
+

          
M testing/scrambleint.sc +0 -1
@@ 312,7 312,6 @@ fn testmap2 ()
 do
     testmap keys
     #testmap2;
-
 #do
     print
         ixorshiftl (xorshiftl 192384:u32 9:u32) 9:u32

          
A => testing/test_hashstack.sc +90 -0
@@ 0,0 1,90 @@ 
+
+# hash stack
+
+import ..lib.tukan.use
+using import tukan.hash
+
+fn hstack ()
+    return 0:u64 #((hash 0) as integer)
+
+fn hpush (a b)
+    hpush a ((hash b) as integer)
+
+fn hpop (a b)
+    hpop a ((hash b) as integer)
+
+let q = (hstack)
+print q
+let q = (hpush q 1)
+print 1 q
+let q = (hpush q 2)
+print 1 2 q
+let q = (hpush q 3)
+print 1 2 3 q
+let q = (hpush q 4)
+print 1 2 3 4 q
+let q = (hpop q 4)
+print 1 2 3 q
+let q = (hpop q 3)
+print 1 2 q
+let q = (hpop q 2)
+print 1 q
+let q = (hpop q 1)
+print q
+
+do
+    using import testing
+    using import Map
+    local seen : (Map u64 string)
+
+    let q = (hstack)
+    'set seen q ""
+
+    let R = 22
+    for x in (range R)
+        let q = (hpush q x)
+        let s = (tostring x)
+        test (not (q in seen))
+        'set seen q s
+        for y in (range R)
+            let q = (hpush q y)
+            let s = (.. s " " (tostring y))
+            if (q in seen)
+                print x y
+                print ('getdefault seen q "?")
+            test (not (q in seen))
+            'set seen q s
+            for z in (range R)
+                let q = (hpush q z)
+                let s = (.. s " " (tostring z))
+                if (q in seen)
+                    print x y z
+                    print ('getdefault seen q "?")
+                test (not (q in seen))
+                'set seen q s
+                for w in (range R)
+                    let q = (hpush q w)
+                    let s = (.. s " " (tostring w))
+                    if (q in seen)
+                        print x y z w
+                        print ('getdefault seen q "?")
+                    test (not (q in seen))
+                    'set seen q s
+                    for n in (range R)
+                        let q = (hpush q n)
+                        let s = (.. s " " (tostring n))
+                        if (q in seen)
+                            print x y z w n
+                            print ('getdefault seen q "?")
+                        test (not (q in seen))
+                        'set seen q s
+                        for t in (range R)
+                            let q = (hpush q t)
+                            let s = (.. s " " (tostring t))
+                            if (q in seen)
+                                print x y z w n t
+                                print ('getdefault seen q "?")
+                            test (not (q in seen))
+                            'set seen q s
+
+;