b5af24594a11 — Leonard Ritter a month ago
* more work on test_uvm3
1 files changed, 250 insertions(+), 2 deletions(-)

M testing/test_uvm3.sc
M testing/test_uvm3.sc +250 -2
@@ 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