# HG changeset patch
# User Leonard Ritter <contact@leonard-ritter.com>
# Date 1602349882 -7200
#      Sat Oct 10 19:11:22 2020 +0200
# Node ID 5e99849baf943cc88c59e6db612e9652fc873800
# Parent  3c5cd78fbdcf25273cbd379f6e4eb7ff9694e7cd
* more work on UVM

diff --git a/lib/tukan/libbf.sc b/lib/tukan/libbf.sc
--- a/lib/tukan/libbf.sc
+++ b/lib/tukan/libbf.sc
@@ -19,6 +19,10 @@
         BF_FTOA_ADD_PREFIX   = (1 << 21)
         BF_FTOA_JS_QUIRKS    = (1 << 22)
 
+    fn bf_neg (r)
+        r.sign ^= 1
+        ;
+
     fn bf_realloc (s ptr size)
         s.realloc_func s.realloc_opaque ptr size
 
diff --git a/lib/tukan/ustore.sc b/lib/tukan/ustore.sc
--- a/lib/tukan/ustore.sc
+++ b/lib/tukan/ustore.sc
@@ -25,8 +25,7 @@
     Symbol = 2 # utf-8 string
     Number = 3 # sign, expn, len, bits...
     Table = 4
-    TableBranch = 5
-    TableLeaf = 6
+    TableLimb = 5
 
 struct URef plain
     Hasher := SHA224
@@ -44,6 +43,9 @@
             0x2fe4b3c5:u32
     kind : URefKind = URefKind.Unknown
 
+    fn null? (self)
+        self == (this-type)
+
     fn... set (self, data : voidstar, size : usize)
         cls := (typeof self)
         local sha : Hasher
@@ -56,6 +58,22 @@
         set self data size
         self
 
+    inline __== (cls T)
+        static-if (cls == T)
+            fn (self other)
+                and
+                    self.kind == other.kind 
+                    self.address == other.address
+
+    inline __as (cls T)
+        static-if (T == integer)
+            fn (self)
+                let self =
+                    static-if (&? self) self
+                    else
+                        local self = self
+                @ (bitcast (& self.address) (pointer (integer 224)))
+
     fn __repr (self)
         values := self.address
         .. "(URef "
diff --git a/testing/test_uvm.sc b/testing/test_uvm.sc
--- a/testing/test_uvm.sc
+++ b/testing/test_uvm.sc
@@ -8,6 +8,14 @@
 using import tukan.ustore
 using import tukan.libbf
 
+#
+    new idea for VM:
+    number = fp128
+    tuple as basic composite
+
+# Number
+###############################################################################
+
 let realloc =
     extern 'realloc
         function voidstar voidstar usize
@@ -46,6 +54,12 @@
         bf_ftoa &sz x 10 Number.DEFAULT_PREC BF_FTOA_FORMAT_FREE_MIN
     String s sz
 
+fn bftosstr (x)
+    local sz : u64
+    let s =
+        bf_ftoa &sz x 10 Number.DEFAULT_PREC BF_FTOA_FORMAT_FREE_MIN
+    string s sz
+
 fn numbertobf (r ref)
     let num =
         bitcast ('load ref) (pointer Number)
@@ -65,6 +79,14 @@
     bf_delete &n
     str
 
+fn numbertosstr (ref)
+    local n : bf_t
+    bf_init &bf_ctx &n
+    numbertobf &n ref
+    let str = (bftosstr &n)
+    bf_delete &n
+    str
+
 inline gen-number (f value)
     local n : bf_t
     bf_init &bf_ctx &n
@@ -80,6 +102,16 @@
 case (value : f64)
     gen-number bf_set_float64 value
 
+inline number_op0_inplace (f ...)
+    fn (x)
+        local res : bf_t
+        bf_init &bf_ctx &res
+        numbertobf &res x
+        f &res ...
+        let result = (Number.from_bf res)
+        bf_delete &res
+        result
+
 inline number_op0 (f ...)
     fn ()
         local res : bf_t
@@ -119,9 +151,24 @@
         bf_delete &res
         result
 
+fn number-cmp (a b)
+    local bfa : bf_t
+    local bfb : bf_t
+    bf_init &bf_ctx &bfa
+    bf_init &bf_ctx &bfb
+    numbertobf &bfa a
+    numbertobf &bfb b
+    let result = (bf_cmp &bfa &bfb)
+    bf_delete bfa
+    bf_delete bfb
+    result
+
 let number-const-log2 = (number_op0 bf_const_log2 Number.DEFAULT_PREC 0)
 let number-const-pi = (number_op0 bf_const_pi Number.DEFAULT_PREC 0)
 
+let number-toint = (number_op0_inplace bf_rint bf_rnd_t.BF_RNDZ)
+let number-neg = (number_op0_inplace bf_neg)
+
 let number-add = (number_op2 bf_add Number.DEFAULT_PREC 0)
 let number-sub = (number_op2 bf_sub Number.DEFAULT_PREC 0)
 let number-mul = (number_op2 bf_mul Number.DEFAULT_PREC 0)
@@ -146,20 +193,251 @@
 let number-asin = (number_op1 bf_asin Number.DEFAULT_PREC 0)
 let number-acos = (number_op1 bf_acos Number.DEFAULT_PREC 0)
 
-try 
+fn number-int? (x)
+    (number-cmp x (number-toint x)) == 0
+
+# String
+###############################################################################
+
+inline... ustring (str : string)
+    local uref = (URef.store (str as rawstring) (countof str))
+    uref.kind = URef.Kind.String
+    uref
+
+inline... usymbol (str : string)
+    local uref = (URef.store (str as rawstring) (countof str))
+    uref.kind = URef.Kind.Symbol
+    uref
+
+# Table
+###############################################################################
+
+let TableCellCount = 16
+
+struct TableLimb plain
+    cells : (array URef TableCellCount)
+    used : u64 = 0 # slots used
+
+    fn unref (uref)
+        ptrtoref
+            bitcast ('load uref) (pointer this-type)
+
+    fn ref (limb)
+        local uref = (URef.store &limb (sizeof limb))
+        uref.kind = URef.Kind.TableLimb
+        uref
+
+struct Table plain
+    keys : URef
+    values : URef
+
+    fn unref (uref)
+        ptrtoref
+            bitcast ('load uref) (pointer this-type)
+
+    fn ref (table)
+        local uref = (URef.store &table (sizeof table))
+        uref.kind = URef.Kind.Table
+        uref
+
+fn... table-set (table, key : URef, value : URef)
+    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)
+        if (keylimb.kind == URef.Kind.TableLimb) # branch
+            assert (valuelimb.kind == URef.Kind.TableLimb)
+            local newkl = (TableLimb.unref keylimb)
+            local newvl = (TableLimb.unref valuelimb)
+            let currentkey = (copy (newkl.cells @ mask))
+            let subkeylimb subvaluelimb =
+                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)
+        elseif (('null? keylimb) or (keylimb == key)) # empty or same key
+            if ('null? value) # clear
+                return (URef) (URef)
+            else
+                return key value
+        else # split?
+            if ('null? value)
+                # we're removing this value anyway
+                return (copy keylimb) (copy valuelimb)
+            let oldmask = ((((keylimb as integer) >> (depth * 4)) as u32) & 0xf)
+            local limb : TableLimb
+            for i in (range TableCellCount)
+                limb.cells @ i = (URef) 
+            limb.used = 1
+            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
+    'ref table
+
+fn... table-del (table, key : URef)
+    table-set table key (URef)
+
+fn... table-get (table, key : URef)
+    table := (Table.unref table)
+    fn recur (keylimb valuelimb key depth)
+        returning URef
+        let mask = ((((key as integer) >> (depth * 4)) as u32) & 0xf)
+        if (keylimb.kind == URef.Kind.TableLimb) # branch
+            local newkl = (TableLimb.unref keylimb)
+            local newvl = (TableLimb.unref valuelimb)
+            return
+                this-function (newkl.cells @ mask) (newvl.cells @ mask) key (depth + 1)
+        elseif (keylimb == key) # found key
+            return (copy valuelimb)
+        # key not found
+        return (URef)
+    recur table.keys table.values key 0
+
+fn table-dump (table)
+    print "table" table
+    table := (Table.unref table)
+    fn recur (pre keylimb valuelimb depth)
+        returning void
+        if (keylimb.kind == URef.Kind.TableLimb) # branch
+            let kl = (TableLimb.unref keylimb)
+            let vl = (TableLimb.unref valuelimb)
+            print
+                .. pre
+                    repr keylimb
+                    " "
+                    repr valuelimb
+            for i in (range TableCellCount)
+                this-function
+                    .. pre "  @" (repr i) ": "
+                    kl.cells @ i
+                    vl.cells @ i
+                    depth + 1
+        elseif (not ('null? keylimb))
+            print
+                .. pre
+                    repr keylimb
+                    "="
+                    repr valuelimb
+        else
+            print
+                .. pre "null"
+    recur "  " table.keys table.values 0
+    print;
+
+fn table (...)
+    local table : Table
+    let t = ('ref table)
+    va-lfold t
+        inline (key value t)
+            table-set t
+                usymbol (key as string)
+                value
+        ...
+
+
+
+###############################################################################
+
+fn uref-repr (value)
+    switch value.kind
+    case URef.Kind.Number
+        let str = (numbertosstr value)
+        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
+    default
+        String
+            repr value
+
+###############################################################################
+
+fn table-tests ()
+    let t = (table)
+    print "empty table:" t
+    let t =
+        table-set t (ustring "key") (ustring "value")
+    print "after 1 insert:" t
+    table-dump t
+    let t =
+        table-set t (ustring "key2") (ustring "value")
+    print "after 2 insert:" t
+    table-dump t
+    print "get" (table-get t (ustring "key"))
+    let t =
+        table-del t (ustring "key")
+    table-dump t
+    let t =
+        table-del t (ustring "key2")
+    table-dump t
+    print "get" (table-get t (ustring "key"))
+
+fn number-tests()
     print
         number -1
         number 0
         number 1
         number 2
     print
-        numbertostr (number-const-pi)
+        uref-repr (number-const-pi)
+    value :=
+        number-neg
+            number-toint
+                number-sqrt
+                    number-or
+                        number 41
+                        number 10
+    print
+        numbertostr value
     print
-        numbertostr
-            number-sqrt
-                number-or
-                    number 41
-                    number 10
+        number-cmp value (number -6)
+    print (number-int? value)
+
+try
+    print (uref-repr (ustring "test"))
+    print (uref-repr (number 3.5))
+    print
+        uref-repr
+            table
+                key1 = (ustring "value")
+
+
+    #table-tests;
+    #number-tests;
+#
+    print "final emptied table:" t
+    print
+        ustring "hello"
 else
     print "failed"