@@ 237,11 237,33 @@ let IndexBits = 4
let ArrayCellCount = (1 << IndexBits)
let IndexMask = (ArrayCellCount - 1)
+fn depth-maxindex (depth)
+ ((ArrayCellCount as u64) << (depth * IndexBits)) - 1
+
@@ verify-sizeof 136
struct TableLimb
cells : (array UAtom ArrayCellCount)
mask : u64 = 0 # slots used
+ fn uhash (self)
+ viewing self
+ local digest : SHA256.DigestType
+ local sha : SHA256
+ for i in (range ArrayCellCount)
+ local celldigest = ('uhash (self.cells @ i))
+ 'hash sha (&celldigest as rawstring) (sizeof celldigest)
+ 'hash sha (&self.mask as rawstring) (sizeof self.mask)
+ 'digest sha digest
+ digest
+
+ fn __copy (self)
+ viewing self
+ super-type.__typecall this-type
+ cells = (typeinit (va-map copy (unpack self.cells)))
+ mask = self.mask
+
+ fn __repr (self) "<TableLimb>"
+
@@ verify-sizeof 40
struct Table
meta : UAtom
@@ 250,6 272,181 @@ struct Table
ivalues : UAtom
depth : u64
+ fn __copy (self)
+ viewing self
+ super-type.__typecall this-type
+ meta = (copy self.meta)
+ keys = (copy self.keys)
+ values = (copy self.values)
+ ivalues = (copy self.ivalues)
+ depth = self.depth
+
+ fn uhash (self)
+ viewing self
+ local digest : SHA256.DigestType
+ local sha : SHA256
+ va-map
+ inline (name)
+ let member = (getattr self name)
+ local memberdigest = ('uhash member)
+ 'hash sha (&memberdigest as rawstring) (sizeof memberdigest)
+ \ 'meta 'keys 'values 'ivalues
+ local depth = self.depth
+ 'hash sha (&depth as rawstring) (sizeof depth)
+ 'digest sha digest
+ digest
+
+ @@ memo
+ inline gen-each-index (f)
+ fn process (table ...)
+ fn recur (node depth index ...)
+ returning void
+ dispatch node
+ case TableLimb (limb)
+ let maxindex = (depth-maxindex depth)
+ let slot-capacity = ((maxindex >> IndexBits) + 1)
+ for i in (range ArrayCellCount)
+ let index = (index + slot-capacity * i)
+ this-function
+ limb.cells @ i
+ depth - 1
+ index
+ ...
+ case None ()
+ default
+ f index node ...
+ recur table.ivalues table.depth 0:u64 ...
+
+ @@ memo
+ inline gen-each-pair (f)
+ fn process (table ...)
+ fn recur (key value ...)
+ returning void
+ dispatch key
+ case TableLimb (klimb)
+ dispatch value
+ case TableLimb (vlimb)
+ let kl = klimb.cells
+ let vl = vlimb.cells
+ for i in (range ArrayCellCount)
+ let k v =
+ kl @ i
+ vl @ i
+ this-function k v ...
+ default
+ assert false "table structure: internal error"
+ unreachable;
+ case None ()
+ default
+ f key value ...
+ recur table.keys table.values ...
+
+ fn __repr (self) "<Table>"
+
+ fn capacity (self)
+ depth-maxindex (copy self.depth)
+
+ fn... set-index (self, index : u64, value : UAtom)
+ fn recur (node depth index value)
+ returning (uniqueof UAtom -1) 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 ('none? value)
+ # nothing to do
+ return node depth
+ if ('none? 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 = (UAtom)
+ let node = (UAtom newlimb)
+ if (index > maxindex)
+ repeat node newdepth
+ else
+ break node newdepth
+ else
+ _ node depth
+
+ let newlimb =
+ dispatch node
+ case TableLimb (limb)
+ local newlimb = (copy limb)
+ default
+ # split
+ local newlimb : TableLimb
+ if (not ('none? node))
+ newlimb.mask = 1
+ newlimb.cells @ 0 = node
+ for i in (range 1 ArrayCellCount)
+ newlimb.cells @ i = (UAtom)
+ 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 ('none? value)
+ newlimb.mask &= (~ flag)
+ else
+ newlimb.mask |= flag
+ if (newlimb.mask == 0) # empty
+ return (UAtom) depth
+ else
+ newlimb.cells @ slot-index = value
+ return
+ UAtom newlimb
+ newdepth
+ # truncate excess capacity
+ let node depth =
+ loop (node depth = (recur self.ivalues (copy self.depth) index value))
+ dispatch node
+ case TableLimb (limb)
+ if (limb.mask == 1)
+ repeat
+ copy (limb.cells @ 0)
+ depth - 1
+ default;
+ break node depth
+ local self = (copy self)
+ self.ivalues = node
+ self.depth = depth
+ self
+
# UAtom
################################################################################
@@ 356,6 553,43 @@ type+ UAtom
viewing self
((ptrtoint (storagecast self) usize) & 0xf) as (storageof Kind) as Kind
+ @@ memo
+ inline __as (cls T)
+ static-if (T == bool)
+ inline (self)
+ switch (kind self)
+ case Kind.False false
+ case Kind.True true
+ default
+ assert false "UAtom isn't a boolean"
+ unreachable;
+ elseif (T == Number)
+ inline (self)
+ assert ((kind self) == Kind.Number)
+ (bitcast (topointer self) UNumber) . data
+ elseif (T == TableLimb)
+ inline (self)
+ assert ((kind self) == Kind.TableLimb)
+ (bitcast (topointer self) UTableLimb) . data
+ elseif (T == Table)
+ inline (self)
+ assert ((kind self) == Kind.Table)
+ (bitcast (topointer self) UTable) . data
+ elseif (T == String)
+ inline (self)
+ switch (kind self)
+ pass Kind.String
+ pass Kind.Symbol
+ do
+ (bitcast (topointer self) UString) . data
+ default
+ assert false "UAtom isn't a boolean"
+ unreachable;
+ elseif (T == Nothing)
+ inline (self)
+ assert ((kind self) == Kind.None)
+ none
+
fn uhash (self)
let ptr = (topointer self)
let kind = ('kind self)
@@ 465,12 699,15 @@ type+ UAtom
__drop (bitcast ptr UTable)
default;
+ fn none? (self)
+ ('kind self) == Kind.None
+
run-stage;
do
let val =
- #UAtom 303
- UAtom "hello"
+ UAtom 303
+ #UAtom "hello"
local digest = ('uhash val)
@@ 484,6 721,17 @@ do
default
print "nope"
+ print ('kind (UAtom))
+
+ let table = (UAtom (Table))
+ print table
+ print
+ UAtom
+ 'set-index (table as Table) 10 (UAtom "test")
+ print
+ UAtom
+ 'set-index (table as Table) 11 (UAtom "test")
+
# e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
#print (sha256-digest-string digest)
#drop val