M lib/tukan/libbf.sc +4 -0
@@ 19,6 19,10 @@ do
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
M lib/tukan/ustore.sc +20 -2
@@ 25,8 25,7 @@ enum URefKind : u32
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 @@ struct URef plain
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 @@ struct URef plain
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 "
M testing/test_uvm.sc +285 -7
@@ 8,6 8,14 @@ import ..lib.tukan.use
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 @@ fn bftostr (x)
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 @@ fn numbertostr (ref)
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 : u64)
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 @@ inline number_op2 (f ...)
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-atan = (number_op1 bf_atan Nu
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"