# HG changeset patch
# User Leonard Ritter <contact@leonard-ritter.com>
# Date 1684995378 -7200
#      Thu May 25 08:16:18 2023 +0200
# Node ID 36dfc0711d9972570e9653412b5e71cb45da1cf2
# Parent  39915d8c09d5534767694ca22b4ce1186bcc6117
* fixed stack overflow when overloading enum repr methods
* atom: use simple sequential hashing instead of merkle tree

diff --git a/lib/scopes/compiler/atom.sc b/lib/scopes/compiler/atom.sc
--- a/lib/scopes/compiler/atom.sc
+++ b/lib/scopes/compiler/atom.sc
@@ -8,6 +8,9 @@
 
 enum Atom
 
+# use a flattened merkle tree rather than sequential hash integration
+USE_MERKLE_TREE := false
+
 ###############################
 
 """"round x to the next highest power of 2
@@ -103,16 +106,49 @@
                 stride := 1:u64 << i as u64
                 HASH-CONSTANT ** stride
             va-range 64
+global hash-constant-exp-rcp =
+    arrayof u64
+        va-map
+            inline (i)
+                stride := 1:u64 << i as u64
+                HASH-CONSTANT^-1 ** stride
+            va-range 64
 
 inline hash-integrate (a b)
     HASH-CONSTANT * a + b
 
+fn hash-constant-pow (k)
+    upper_h := alignsizeu k
+    kinv := upper_h - k
+    sugar-if false
+        # 38% fewer iterations than powi
+        k h map := k, 1:u64, hash-constant-exp
+    else
+        # 50% fewer iterations than powi
+        k h map := if ((bitcount kinv) < (bitcount k))
+            d := findmsb upper_h
+            kinv as u64, copy (hash-constant-exp @ d), hash-constant-exp-rcp
+        else
+            k, 1:u64, hash-constant-exp
+    loop (k h d = k h 0:u64)
+        m := k & -k
+        if (m == 0:u64)
+            break h
+        k := (k // m) & ~1:u64
+        q := findmsb m
+        d := d + q
+        h := h * (map @ d)
+        repeat k h d
+
 inline hash-integrate-join (a b bstride)
     (HASH-CONSTANT ** bstride) * a + b
 
 inline hash-integrate-join-log2 (a b bstridelog2)
     (hash-constant-exp @ bstridelog2) * a + b
 
+inline hash-integral-diff (a b ha hb)
+    hb - ha * (HASH-CONSTANT ** ((b - a) as u64))
+
 ###############################
 
 # a dynamic append-only array with additional structures that lazily provide
@@ -162,78 +198,95 @@
                 super-type.__typecall cls
                     keys = (move self)
 
-    fn invalidate (self offset count)
-        cls := typeof self
-        x0 := offset // cls.Stride
-        x1 := (offset + count + cls.Stride - 1) // cls.Stride
-        hsize := countof self.hashmap
-        offset := offset // cls.Stride
-        stride := alignsizeu (countof self.keys)
-        if (not stride)
-            return;
-        for index in (range x0 x1)
-            index := index * cls.Stride
-            loop (stride)
-                if (stride < cls.Stride)
-                    break;
-                offset := (index // stride)
-                i := hasharray-offset (stride // cls.Stride) offset
-                if (i < hsize)
-                    self.hashmap @ i = 0:u64
-                repeat (stride // 2)
+    sugar-if USE_MERKLE_TREE
+        fn invalidate (self offset count)
+            cls := typeof self
+            x0 := offset // cls.Stride
+            x1 := (offset + count + cls.Stride - 1) // cls.Stride
+            hsize := countof self.hashmap
+            offset := offset // cls.Stride
+            stride := alignsizeu (countof self.keys)
+            if (not stride)
+                return;
+            for index in (range x0 x1)
+                index := index * cls.Stride
+                loop (stride)
+                    if (stride < cls.Stride)
+                        break;
+                    offset := (index // stride)
+                    i := hasharray-offset (stride // cls.Stride) offset
+                    if (i < hsize)
+                        self.hashmap @ i = 0:u64
+                    repeat (stride // 2)
 
-    fn... hashrange (self, offset : usize, size : usize)
-        cls := typeof self
-        returning cls.HashType
-        'update self
-        if (not size)
-            return (cls.HashType 0:u64)
-        cls := typeof self
-        x0 := offset
-        x1 := offset + size
-        h := fold (h = 0:u64) for i stride offset in (enumerate (logrange x0 x1))
-            level := findmsb stride
-            hash-integrate-join-log2 h
-                'hashtile self level offset
-                level
-        cls.HashType h
+        fn... hashrange (self, offset : usize, size : usize)
+            cls := typeof self
+            returning cls.HashType
+            'update self
+            if (not size)
+                return (cls.HashType 0:u64)
+            cls := typeof self
+            x0 := offset
+            x1 := offset + size
+            h := fold (h = 0:u64) for i stride offset in (enumerate (logrange x0 x1))
+                level := findmsb stride
+                hash-integrate-join-log2 h
+                    'hashtile self level offset
+                    level
+            cls.HashType h
 
-    fn... hashrange-slow (self, offset : usize, size : usize)
-        cls := typeof self
-        returning u64
-        fold (sum = 0:u64) for i in (range offset (offset + size))
-            hash-integrate sum ((cls.HashType (self.keys @ i)) as u64)
+        fn... hashrange-slow (self, offset : usize, size : usize)
+            cls := typeof self
+            returning u64
+            fold (sum = 0:u64) for i in (range offset (offset + size))
+                hash-integrate sum ((cls.HashType (self.keys @ i)) as u64)
 
-    fn hashtile (self level offset)
-        cls := typeof self
-        returning u64
-        stride := 1:usize << level
-        x0 := stride * offset
-        if (x0 < (countof self.keys))
-            if (stride < cls.Stride)
-                count := min stride ((countof self.keys) - x0)
-                'hashrange-slow self x0 count
-            else
-                i := hasharray-offset (stride // cls.Stride) offset
-                if (i >= (countof self.hashmap))
-                    'resize self.hashmap (i + 1) 0:u64
-                elseif (self.hashmap @ i != 0:u64)
-                    return
-                        copy (self.hashmap @ i)
-                H := if (stride == cls.Stride)
+        fn hashtile (self level offset)
+            cls := typeof self
+            returning u64
+            stride := 1:usize << level
+            x0 := stride * offset
+            if (x0 < (countof self.keys))
+                if (stride < cls.Stride)
                     count := min stride ((countof self.keys) - x0)
                     'hashrange-slow self x0 count
                 else
-                    # compute leaves
-                    level := level - 1
-                    #stride := stride // 2
-                    offset := offset * 2
-                    L := this-function self level offset
-                    R := this-function self level (offset + 1)
-                    hash-integrate-join-log2 L R level
-                self.hashmap @ i = H
-                copy (self.hashmap @ i)
-        else 0:u64
+                    i := hasharray-offset (stride // cls.Stride) offset
+                    if (i >= (countof self.hashmap))
+                        'resize self.hashmap (i + 1) 0:u64
+                    elseif (self.hashmap @ i != 0:u64)
+                        return
+                            copy (self.hashmap @ i)
+                    H := if (stride == cls.Stride)
+                        count := min stride ((countof self.keys) - x0)
+                        'hashrange-slow self x0 count
+                    else
+                        # compute leaves
+                        level := level - 1
+                        #stride := stride // 2
+                        offset := offset * 2
+                        L := this-function self level offset
+                        R := this-function self level (offset + 1)
+                        hash-integrate-join-log2 L R level
+                    self.hashmap @ i = H
+                    copy (self.hashmap @ i)
+            else 0:u64
+
+    else # not USE_MERKLE_TREE
+        inline hashlrange (self x)
+            if (x > 0) (copy (self.hashmap @ (x - 1)))
+            else 0:u64
+
+        fn... hashrange (self, offset : usize, size : usize)
+            cls := typeof self
+            returning cls.HashType
+            'update self
+            cls := typeof self
+            a b := offset, offset + size
+            ha := hashlrange self a
+            hb := hashlrange self b
+            h := hash-integral-diff a b ha hb
+            cls.HashType h
 
     inline __countof (self)
         countof self.keys
@@ -255,10 +308,20 @@
             the new hash range.
         viewing self
         cls := typeof self
+        inline invalidate_hashmap (pastcount keyscount)
+            sugar-if USE_MERKLE_TREE
+                'invalidate self pastcount (keyscount - pastcount)
+            else
+                h := 'hashlrange self pastcount
+                fold (h) for i in (range pastcount keyscount)
+                    h := hash-integrate h ((cls.HashType (self.keys @ i)) as u64)
+                    'append self.hashmap h
+                    h
+                ;
         static-if cls.Invertible?
             pastcount := countof self.past
             keyscount := countof self.keys
-            'invalidate self pastcount (keyscount - pastcount)
+            invalidate_hashmap pastcount keyscount
             for i in (range pastcount keyscount)
                 key := self.keys @ i
                 j := 'setdefault self.map key NoIndex
@@ -267,7 +330,7 @@
         else
             pastcount := copy self.pastcount
             keyscount := countof self.keys
-            'invalidate self pastcount (keyscount - pastcount)
+            invalidate_hashmap pastcount keyscount
             self.pastcount = keyscount
             ;
 
diff --git a/lib/scopes/core.sc b/lib/scopes/core.sc
--- a/lib/scopes/core.sc
+++ b/lib/scopes/core.sc
@@ -9010,8 +9010,17 @@
                 else
                     `(cenum-repr self)
         bitcast ((compile (typify __repr Value)) as SpiceMacroFunction) SpiceMacro
-    'set-symbol this-type '__repr (gen-repr-func this-type true)
-    'set-symbol this-type '__tostring (gen-repr-func this-type false)
+    try
+        ('local@ this-type '__tostring)
+        ;
+    else
+        'set-symbol this-type '__tostring (gen-repr-func this-type false)
+    try
+        ('local@ this-type '__repr)
+        ;
+    else
+        'set-symbol this-type '__repr (gen-repr-func this-type true)
+    ;
 
 do
     inline simple-unary-storage-op (f)
@@ -9040,7 +9049,7 @@
             spice (self)
                 T := 'typeof self
                 f := try
-                    ('local@ T '__tostring)
+                    ('local@ T '__repr)
                     ;
                 else
                     CEnum.generate-repr T
diff --git a/testing/test_enums.sc b/testing/test_enums.sc
--- a/testing/test_enums.sc
+++ b/testing/test_enums.sc
@@ -316,5 +316,19 @@
 
     test (constant? (K.X == K.X))
 
+do
+    let header =
+        include
+            """"typedef enum Test {
+                    A = 0x0
+                } Test;
+
+    type+ header.enum.Test
+        inline __tostring (self)
+            "anything"
+
+    # should not cause a stack overflow
+    print header.enum.Test.A
+
 ;