c8f2850ba1be — Leonard Ritter a month ago
* UVM: tables have integer support
2 files changed, 402 insertions(+), 50 deletions(-)

M lib/tukan/ustore.sc
M testing/test_uvm.sc
M lib/tukan/ustore.sc +4 -4
@@ 31,7 31,7 @@ struct URef plain
     Hasher := SHA224
     DigestType := Hasher.DigestType
     Kind := URefKind
-    
+
     address : (array u32 7) =
         arrayof u32
             0x8c024ad1:u32

          
@@ 62,7 62,7 @@ struct URef plain
         static-if (cls == T)
             fn (self other)
                 and
-                    self.kind == other.kind 
+                    self.kind == other.kind
                     self.address == other.address
 
     inline __as (cls T)

          
@@ 80,7 80,7 @@ struct URef plain
             ..
                 va-map
                     inline (i)
-                        value := values @ i 
+                        value := values @ i
                         ..
                             va-map
                                 inline (k)

          
@@ 123,7 123,7 @@ struct UMemory plain
             ">"
 
 fn hasher (addr)
-    bor        
+    bor
         imply (addr @ 0) u64
         (imply (addr @ 1) u64) << 32
 

          
M testing/test_uvm.sc +398 -46
@@ 13,6 13,15 @@ using import tukan.libbf
     number = fp128
     tuple as basic composite
 
+inline verify-sizeof (size)
+    inline (T)
+        #static-assert ((alignof T) == 8)
+            .. "(alignof " (tostring T) ") != 8"
+        static-assert ((sizeof T) == size)
+            .. "(sizeof " (tostring T) ") == "
+                \ (tostring (sizeof T)) " != " (tostring size)
+        T
+
 # Number
 ###############################################################################
 

          
@@ 196,6 205,37 @@ let number-acos = (number_op1 bf_acos Nu
 fn number-int? (x)
     (number-cmp x (number-toint x)) == 0
 
+fn number-get-u64 (x)
+    local bfx : bf_t
+    bf_init &bf_ctx &bfx
+    try
+        numbertobf &bfx x
+    else
+        bf_delete &bfx
+        raise;
+
+    local bfcmp : bf_t
+    bf_init &bf_ctx &bfcmp
+    bf_set_zero &bfcmp 0
+    if ((bf_cmp &bfx &bfcmp) >= 0)
+        bf_set_si &bfcmp 0x7fffffffffffffff:i64
+        if ((bf_cmp &bfx &bfcmp) <= 0)
+            local bfint : bf_t
+            bf_init &bf_ctx &bfint
+            bf_set &bfint &bfx
+            bf_rint &bfint bf_rnd_t.BF_RNDZ
+            if ((bf_cmp &bfx &bfint) == 0)
+                local outp : i64
+                bf_get_int64 &outp &bfx 0
+                bf_delete &bfint
+                bf_delete &bfcmp
+                bf_delete &bfx
+                return ((deref outp) as u64)
+            bf_delete &bfint
+    bf_delete &bfcmp
+    bf_delete &bfx
+    raise;
+
 # String
 ###############################################################################
 

          
@@ 212,11 252,15 @@ inline... usymbol (str : string)
 # Table
 ###############################################################################
 
-let TableCellCount = 16
+let IndexBits = 4
+let ArrayCellCount = (1 << IndexBits)
+let IndexMask = (ArrayCellCount - 1)
 
+
+@@ verify-sizeof 520
 struct TableLimb plain
-    cells : (array URef TableCellCount)
-    used : u64 = 0 # slots used
+    cells : (array URef ArrayCellCount)
+    mask : u64 = 0 # slots used
 
     fn unref (uref)
         ptrtoref

          
@@ 227,9 271,12 @@ struct TableLimb plain
         uref.kind = URef.Kind.TableLimb
         uref
 
+@@ verify-sizeof 104
 struct Table plain
     keys : URef
     values : URef
+    ivalues : URef
+    depth : u64
 
     fn unref (uref)
         ptrtoref

          
@@ 240,12 287,189 @@ struct Table plain
         uref.kind = URef.Kind.Table
         uref
 
+fn depth-maxindex (depth)
+    ((ArrayCellCount as u64) << (depth * IndexBits)) - 1
+
+fn table-capacity (uarr)
+    uarr := (Table.unref uarr)
+    depth-maxindex (copy uarr.depth)
+
+fn... table-seti (uarr, index : u64, value : URef)
+    fn recur (node depth index value)
+        returning URef u64
+        raising (uniqueof UError 1)
+
+        if (index == 0)
+            # truncate
+            return value depth
+
+        node := (copy node)
+        maxindex := (depth-maxindex depth)
+        let node depth =
+            if (index > maxindex)
+                # exceeding existing capacity
+                if ('null? value)
+                    # nothing to do
+                    return node depth
+                if ('null? node)
+                    # increase depth until it fits
+                    _ node
+                        loop (depth = depth)
+                            let newdepth = (depth + 1)
+                            maxindex := (depth-maxindex newdepth)
+                            if (index > maxindex)
+                                repeat newdepth
+                            else
+                                break newdepth
+                else
+                    loop (node depth = (copy node) depth)
+                        let newdepth = (depth + 1)
+                        maxindex := (depth-maxindex newdepth)
+                        # split
+                        local newlimb = (TableLimb)
+                        newlimb.mask = 1
+                        newlimb.cells @ 0 = node
+                        for i in (range 1 ArrayCellCount)
+                            newlimb.cells @ i = (URef)
+                        let node = ('ref newlimb)
+                        if (index > maxindex)
+                            repeat node newdepth
+                        else
+                            break node newdepth
+            else
+                _ node depth
+
+        let newlimb =
+            if (node.kind == URef.Kind.TableLimb)
+                local newlimb = (TableLimb.unref node)
+            else
+                # split
+                local newlimb = (TableLimb)
+                newlimb.cells @ 0 = node
+                if (not ('null? node))
+                    newlimb.mask = 1
+                for i in (range 1 ArrayCellCount)
+                    newlimb.cells @ i = (URef)
+                newlimb
+
+        maxindex := (depth-maxindex depth)
+        let slot-capacity = ((maxindex >> IndexBits) + 1)
+        let slot-index = (index // slot-capacity)
+        assert (slot-index < ArrayCellCount)
+
+        # subindex
+        let index = (index - (slot-index * slot-capacity))
+        let value newdepth =
+            if (depth == 0)
+                _ (copy value) depth
+            else
+                let value depth =
+                    this-function (newlimb.cells @ slot-index) (depth - 1) index value
+                _ value (depth + 1)
+        flag := 1:u64 << slot-index
+        if ('null? value)
+            newlimb.mask &= (~ flag)
+        else
+            newlimb.mask |= flag
+        if (newlimb.mask == 0) # empty
+            return (URef) depth
+        else
+            newlimb.cells @ slot-index = value
+            return
+                'ref newlimb
+                newdepth
+    uarr := (Table.unref uarr)
+    # truncate excess capacity
+    let node depth =
+        loop (node depth = (recur uarr.ivalues (copy uarr.depth) index value))
+            if (node.kind == URef.Kind.TableLimb)
+                let limb = (TableLimb.unref node)
+                if (limb.mask == 1)
+                    repeat
+                        copy (limb.cells @ 0)
+                        depth - 1
+            break node depth
+    local uarr = uarr
+    uarr.ivalues = node
+    uarr.depth = depth
+    'ref uarr
+
+fn... table-deli (uarr, index : u64)
+    table-seti uarr index (URef)
+
+fn... table-geti (uarr, index : u64)
+    uarr := (Table.unref uarr)
+    fn recur (node depth index)
+        returning URef
+        #raising (uniqueof UError 1)
+
+        node := (copy node)
+
+        maxindex := (depth-maxindex depth)
+        if (index > maxindex)
+            return (URef)
+
+        if (node.kind != URef.Kind.TableLimb)
+            if (index == 0)
+                return node
+            else
+                return (URef)
+
+        let limb = (TableLimb.unref node)
+
+        let slot-capacity = ((maxindex >> IndexBits) + 1)
+        let slot-index = (index // slot-capacity)
+        assert (slot-index < ArrayCellCount)
+
+        let subnode = (copy (limb.cells @ slot-index))
+
+        # subindex
+        let index = (index - (slot-index * slot-capacity))
+        if (depth == 0)
+            return subnode
+        this-function subnode (depth - 1) index
+    recur (copy uarr.ivalues) (copy uarr.depth) index
+
+fn table-last-index (uarr)
+    uarr := (Table.unref uarr)
+    if ('null? uarr.ivalues)
+        return -1:u64
+    loop (node depth index = (deref uarr.ivalues) (copy uarr.depth) 0:u64)
+        if (node.kind == URef.Kind.TableLimb) # branch
+            let limb = (TableLimb.unref node)
+            repeat
+                label found
+                    for i in (rrange ArrayCellCount)
+                        let node =
+                            deref (limb.cells @ i)
+                        if (not ('null? node))
+                            maxindex := (depth-maxindex depth)
+                            let slot-capacity = ((maxindex >> IndexBits) + 1)
+                            merge found node
+                                depth - 1
+                                index + slot-capacity * i
+                    else
+                        assert false "unexpected end"
+                        unreachable;
+        else
+            break index
+
+fn... table-append (uarr, value : URef)
+    table-seti uarr ((table-last-index uarr) + 1) value
+
 fn... table-set (table, key : URef, value : URef)
+    label do-regular-set
+        if (key.kind == URef.Kind.Number)
+            let index =
+                try (number-get-u64 key)
+                else
+                    merge do-regular-set
+            return (table-seti table index value)
     table := (Table.unref table)
     fn recur (keylimb valuelimb key value depth)
         returning URef URef
         assert (depth <= 56)
-        let mask = ((((key as integer) >> (depth * 4)) as u32) & 0xf)
+        let mask = ((((key as integer) >> (depth * IndexBits)) as u32) & IndexMask)
         if (keylimb.kind == URef.Kind.TableLimb) # branch
             assert (valuelimb.kind == URef.Kind.TableLimb)
             local newkl = (TableLimb.unref keylimb)

          
@@ 255,28 479,23 @@ fn... table-set (table, key : URef, valu
                 this-function currentkey (newvl.cells @ mask) key value (depth + 1)
             newkl.cells @ mask = subkeylimb
             newvl.cells @ mask = subvaluelimb
-            if (currentkey != subkeylimb)
-                if ('null? subkeylimb)
-                    # cleared
-                    newkl.used -= 1
-                    newvl.used -= 1
-                    assert (newkl.used >= 1)
-                    #if (newkl.used == 0)
-                        print "completely empty"
-                        # completely empty
-                        return (URef) (URef)
-                    if (newkl.used == 1)
-                        # only one left, revert split
-                        for i in (range TableCellCount)
-                            if (not ('null? (newkl.cells @ i)))
-                                return (copy (newkl.cells @ i)) (copy (newvl.cells @ i))
-                        assert false "1 was indicated as used but not found"
-                        unreachable;
-                elseif ('null? currentkey)
-                    # added
-                    newkl.used += 1
-                    newvl.used += 1
-            return ('ref newkl) ('ref newvl)
+            flag := 1:u64 << mask
+            if ('null? subkeylimb)
+                flag := (~ flag)
+                newkl.mask &= flag
+                newvl.mask &= flag
+            else
+                newkl.mask |= flag
+                newvl.mask |= flag
+            assert (newkl.mask != 0)
+            if ((bitcount newkl.mask) == 1)
+                let index = (findmsb newkl.mask)
+                assert (index < ArrayCellCount)
+                let node = (newkl.cells @ index)
+                assert (not ('null? node))
+                return (copy node) (copy (newvl.cells @ index))
+            else
+                return ('ref newkl) ('ref newvl)
         elseif (('null? keylimb) or (keylimb == key)) # empty or same key
             if ('null? value) # clear
                 return (URef) (URef)

          
@@ 286,30 505,45 @@ fn... table-set (table, key : URef, valu
             if ('null? value)
                 # we're removing this value anyway
                 return (copy keylimb) (copy valuelimb)
-            let oldmask = ((((keylimb as integer) >> (depth * 4)) as u32) & 0xf)
+            let oldmask = ((((keylimb as integer) >> (depth * IndexBits)) as u32) & IndexMask)
             local limb : TableLimb
-            for i in (range TableCellCount)
-                limb.cells @ i = (URef) 
-            limb.used = 1
+            for i in (range ArrayCellCount)
+                limb.cells @ i = (URef)
+            limb.mask = 1:u64 << oldmask
             limb.cells @ oldmask = keylimb
             let kref = ('ref limb)
             limb.cells @ oldmask = valuelimb
             let vref = ('ref limb)
             return
                 this-function kref vref key value depth
-    local table =
-        Table
-            recur table.keys table.values key value 0
+    let keys values = (recur table.keys table.values key value 0)
+    local table = table
+    table.keys = keys
+    table.values = values
     'ref table
 
 fn... table-del (table, key : URef)
+    label do-regular-del
+        if (key.kind == URef.Kind.Number)
+            let index =
+                try (number-get-u64 key)
+                else
+                    merge do-regular-del
+            return (table-deli table index)
     table-set table key (URef)
 
 fn... table-get (table, key : URef)
+    label do-regular-get
+        if (key.kind == URef.Kind.Number)
+            let index =
+                try (number-get-u64 key)
+                else
+                    merge do-regular-get
+            return (table-geti table index)
     table := (Table.unref table)
     fn recur (keylimb valuelimb key depth)
         returning URef
-        let mask = ((((key as integer) >> (depth * 4)) as u32) & 0xf)
+        let mask = ((((key as integer) >> (depth * IndexBits)) as u32) & IndexMask)
         if (keylimb.kind == URef.Kind.TableLimb) # branch
             local newkl = (TableLimb.unref keylimb)
             local newvl = (TableLimb.unref valuelimb)

          
@@ 324,6 558,36 @@ fn... table-get (table, key : URef)
 fn table-dump (table)
     print "table" table
     table := (Table.unref table)
+    fn recur (pre node depth index)
+        returning void
+        let maxindex = (depth-maxindex depth)
+        if (node.kind == URef.Kind.TableLimb) # branch
+            let limb = (TableLimb.unref node)
+            let slot-capacity = ((maxindex >> IndexBits) + 1)
+            print
+                .. pre
+                    repr node
+                    " (capacity: "
+                    repr (maxindex + 1)
+                    " mask: 0b"
+                    bin limb.mask
+                    ")"
+            for i in (range ArrayCellCount)
+                let index = (index + slot-capacity * i)
+                this-function
+                    .. pre "  @" (repr index) ": "
+                    limb.cells @ i
+                    depth - 1
+                    index
+        elseif (not ('null? node))
+            print
+                .. pre
+                    repr node
+        else
+            print
+                .. pre "null"
+    print "max index:" (depth-maxindex (copy table.depth))
+    recur "  " table.ivalues (copy table.depth) 0
     fn recur (pre keylimb valuelimb depth)
         returning void
         if (keylimb.kind == URef.Kind.TableLimb) # branch

          
@@ 334,7 598,7 @@ fn table-dump (table)
                     repr keylimb
                     " "
                     repr valuelimb
-            for i in (range TableCellCount)
+            for i in (range ArrayCellCount)
                 this-function
                     .. pre "  @" (repr i) ": "
                     kl.cells @ i

          
@@ 357,25 621,86 @@ fn table (...)
     let t = ('ref table)
     va-lfold t
         inline (key value t)
-            table-set t
-                usymbol (key as string)
-                value
+            static-if (key == unnamed)
+                table-append t value
+            else
+                table-set t
+                    usymbol (key as string)
+                    value
         ...
 
-
-
 ###############################################################################
 
 fn uref-repr (value)
+    #returning String
+
+    let uref-repr = this-function
+    if ('null? value)
+        return (String "null")
+
     switch value.kind
     case URef.Kind.Number
         let str = (numbertosstr value)
-        String (default-styler style-number str)
+        return
+            String (default-styler style-number str)
     case URef.Kind.String
         let buf sz = ('load value)
         let str = (string (buf as rawstring) sz)
         String
             repr str
+    case URef.Kind.Symbol
+        let buf sz = ('load value)
+        let str = (Symbol (string (buf as rawstring) sz))
+        String
+            repr str
+    case URef.Kind.Table
+        table := (Table.unref value)
+        local str : String
+        'append str "("
+        local count = 0
+        fn recur (str node depth index count)
+            returning void
+            let maxindex = (depth-maxindex depth)
+            if (node.kind == URef.Kind.TableLimb) # branch
+                let limb = (TableLimb.unref node)
+                let slot-capacity = ((maxindex >> IndexBits) + 1)
+                for i in (range ArrayCellCount)
+                    let index = (index + slot-capacity * i)
+                    this-function str
+                        limb.cells @ i
+                        depth - 1
+                        index
+                        count
+            elseif (not ('null? node))
+                if (count > 0)
+                    'append str " "
+                if (count != index)
+                    'append str
+                        default-styler style-number (tostring index)
+                    'append str "="
+                'append str (uref-repr node)
+                count += 1
+        recur str table.ivalues table.depth 0:u64 count
+        fn recur (str key value count)
+            returning void
+            if (key.kind == URef.Kind.TableLimb) # branch
+                let kl = ((TableLimb.unref key) . cells)
+                let vl = ((TableLimb.unref value) . cells)
+                for i in (range ArrayCellCount)
+                    let k v =
+                        kl @ i
+                        vl @ i
+                    this-function str k v count
+            elseif (not ('null? key))
+                if (count > 0)
+                    'append str " "
+                'append str (uref-repr key)
+                'append str "="
+                'append str (uref-repr value)
+                count += 1
+        recur str table.keys table.values count
+        'append str ")"
+        deref str
     default
         String
             repr value

          
@@ 402,7 727,7 @@ fn table-tests ()
     table-dump t
     print "get" (table-get t (ustring "key"))
 
-fn number-tests()
+fn number-tests ()
     print
         number -1
         number 0

          
@@ 423,17 748,44 @@ fn number-tests()
         number-cmp value (number -6)
     print (number-int? value)
 
-try
+fn uref-tests ()
     print (uref-repr (ustring "test"))
     print (uref-repr (number 3.5))
+    let t =
+        table
+            number 23
+            number 42
+            number 303
+            key1 = (ustring "value")
+            key2 = (ustring "value2")
+    let t =
+        table-set t (number 10) (ustring "test")
     print
-        uref-repr
-            table
-                key1 = (ustring "value")
+        uref-repr t
 
+fn uarray-tests ()
+    let a = (table)
+    table-dump a
+    let a = (table-seti a 1 (number 1))
+    table-dump a
+    let a = (table-seti a 960 (number 960))
+    table-dump a
+    let a = (table-seti a 254 (number 960))
+    table-dump a
+    let a = (table-deli a 960)
+    table-dump a
+    let a = (table-deli a 254)
+    table-dump a
+    print "last index:" (table-last-index a)
+    #let a =
+        uarray-set-index a 1000 (URef)
+    #uarray-dump a
 
+try
     #table-tests;
     #number-tests;
+    uref-tests;
+    #uarray-tests;
 #
     print "final emptied table:" t
     print