561d59082789 — Leonard Ritter a month ago
* `File`: added `'tell` and `'seek`
* UVM3: crunched pickled format by factor 10
2 files changed, 191 insertions(+), 68 deletions(-)

M lib/tukan/File.sc
M testing/test_uvm3.sc
M lib/tukan/File.sc +12 -8
@@ 18,11 18,14 @@ let
     ftell = (extern 'ftell (function i64 FILE*))
     ferror = (extern 'ferror (function i32 FILE*))
     fflush = (extern 'fflush (function i32 FILE*))
+    strerror = (extern 'strerror (function rawstring i32))
     errno = (extern 'errno i32)
 
 struct File
     _handle : FILE*
 
+    let strerror
+
     inline __typecall (cls)
         static-error "use File.open to create files"
 

          
@@ 37,16 40,17 @@ struct File
         ftell self._handle
 
     inline seek (self set at end)
-        fseek self._handle
-            static-if (not (none? set))
-                _ set SEEK_SET
-            elseif (not (none? end))
-                _ end SEEK_END
-            else
-                _ at SEEK_CUR
+        == 0
+            fseek self._handle
+                static-if (not (none? set))
+                    _ set SEEK_SET
+                elseif (not (none? end))
+                    _ end SEEK_END
+                else
+                    _ at SEEK_CUR
 
     inline error? (self)
-        ferror self._handle
+        _ (ferror self._handle) (deref (@ errno))
 
     inline write (self ptr size)
         (fwrite ptr size 1 self._handle) == 1

          
M testing/test_uvm3.sc +179 -60
@@ 96,23 96,35 @@ type Number :: (storageof bf_t)
     inline writer (f)
         fn write (self ...)
             viewing self
-            let self = (bitcast self bf_t)
-            va-map
-                inline (name)
-                    let member = (getattr self name)
-                    f (&member as rawstring) (sizeof member) ...
-                \ 'sign 'expn 'len
-            f (self.tab as rawstring) ((sizeof (self.tab @ 0)) * self.len) ...
+            let index =
+                try ('toindex32 self)
+                else
+                    let self = (bitcast self bf_t)
+                    va-map
+                        inline (name)
+                            let member = (getattr self name)
+                            f (&member as rawstring) (sizeof member) ...
+                        \ 'sign 'expn 'len
+                    f (self.tab as rawstring) ((sizeof (self.tab @ 0)) * self.len) ...
+                    return;
+            local index : i32 = (- (index as i32))
+            f (&index as rawstring) (sizeof index) ...
+            ;
 
     @@ memo
     inline reader (f)
         fn read (...)
+            local index : i32
+            f (&index as rawstring) (sizeof index) ...
+            if (index < 0)
+                return (this-type -index)
             local source : bf_t
+            source.sign = index
             va-map
                 inline (name)
                     let member = (getattr source name)
                     f (&member as rawstring) (sizeof member) ...
-                \ 'sign 'expn 'len
+                \ 'expn 'len
             let limbT = (typeof (source.tab @ 0))
             source.tab = (alloca-array limbT source.len)
             f (source.tab as rawstring) ((sizeof limbT) * source.len) ...

          
@@ 153,6 165,13 @@ type Number :: (storageof bf_t)
         bf_get_float64 self &outp bf_rnd_t.BF_RNDN
         outp
 
+    fn toindex32 (self)
+        if (self >= 0)
+            if (self <= 0x7fffffff:i32)
+                if (('floor self) == self)
+                    return ((toi32 self) as u32)
+        raise;
+
     fn toindex (self)
         if (self >= 0)
             if (self <= 0x7fffffffffffffff:i64)

          
@@ 283,6 302,7 @@ type UAtom :: voidstar
 let IndexBits = 4
 let ArrayCellCount = (1 << IndexBits)
 let IndexMask = (ArrayCellCount - 1)
+let CellIndexType = u16
 
 fn depth-maxindex (depth)
     ((ArrayCellCount as u64) << (depth * IndexBits)) - 1

          
@@ 293,27 313,32 @@ struct TableLimb
     mask : u64 = 0 # slots used
 
     @@ memo
-    inline writer (f)
+    inline writer (f hashf)
         fn write (self ...)
             viewing self
+            local mask : CellIndexType = (self.mask as CellIndexType)
+            f (&mask as rawstring) (sizeof mask) ...
             local celldigest : SHA256.DigestType
-            va-map
-                inline (i)
+            inline handle-cell (i)
+                if ((mask & (1 << i)) != 0)
                     celldigest = ('uhash (self.cells @ i))
-                    f (&celldigest as rawstring) (sizeof celldigest) ...
-                va-range ArrayCellCount
-            local mask = self.mask
-            f (&mask as rawstring) (sizeof mask) ...
+                    hashf (&celldigest as rawstring) (sizeof celldigest) ...
+            static-if (&? self)
+                for i in (range ArrayCellCount) (handle-cell i)
+            else
+                va-map handle-cell (va-range ArrayCellCount)
 
     @@ memo
-    inline reader (f)
+    inline reader (f hashf)
         fn read (cache ...)
-            local celldigest : SHA256.DigestType
             local limb : this-type
-            va-map
-                inline (i)
-                    #celldigest = ('uhash (self.cells @ i))
-                    f (&celldigest as rawstring) (sizeof celldigest) ...
+            local mask : CellIndexType
+            f (&mask as rawstring) (sizeof mask) ...
+            limb.mask = mask
+            local celldigest : SHA256.DigestType
+            for i in (range ArrayCellCount)
+                if ((limb.mask & (1 << i)) != 0)
+                    hashf (&celldigest as rawstring) (sizeof celldigest) ...
                     limb.cells @ i =
                         do
                             try

          
@@ 324,14 349,14 @@ struct TableLimb
                                     sha256-digest-string celldigest
                                     \ "(" (UAtom.kind-from-digest celldigest) ")"
                                 UAtom;
-                va-range ArrayCellCount
-            f (&limb.mask as rawstring) (sizeof limb.mask) ...
             limb
 
     let sha-writer =
         writer
             inline (data size sha)
                 'hash sha data size
+            inline (data size sha)
+                'hash sha data size
 
     fn uhash (self)
         viewing self

          
@@ 367,7 392,7 @@ struct Table
             depth = self.depth
 
     @@ memo
-    inline writer (f)
+    inline writer (f hashf)
         fn write (self ...)
             viewing self
             local memberdigest : SHA256.DigestType

          
@@ 375,20 400,20 @@ struct Table
                 inline (name)
                     let member = (getattr self name)
                     memberdigest = ('uhash member)
-                    f (&memberdigest as rawstring) (sizeof memberdigest) ...
+                    hashf (&memberdigest as rawstring) (sizeof memberdigest) ...
                 \ 'meta 'keys 'values 'ivalues
             local depth = self.depth
             f (&depth as rawstring) (sizeof depth) ...
 
     @@ memo
-    inline reader (f)
+    inline reader (f hashf)
         fn read (cache ...)
             local memberdigest : SHA256.DigestType
             local table : this-type
             va-map
                 inline (name)
                     let member = (getattr table name)
-                    f (&memberdigest as rawstring) (sizeof memberdigest) ...
+                    hashf (&memberdigest as rawstring) (sizeof memberdigest) ...
                     member =
                         do
                             try

          
@@ 407,6 432,8 @@ struct Table
         writer
             inline (data size sha)
                 'hash sha data size
+            inline (data size sha)
+                'hash sha data size
 
     fn uhash (self)
         viewing self

          
@@ 943,10 970,15 @@ type+ UAtom
         case bool
             return (value as bool as UAtom)
         default
-            let tk = ('kind ('storageof T))
+            let ST = ('storageof T)
+            let tk = ('kind ST)
             switch tk
             case type-kind-integer
-                return (UAtom (sc_const_int_extract value))
+                let value = (sc_const_int_extract value)
+                if ('signed? ST)
+                    return (UAtom (value as i64))
+                else
+                    return (UAtom value)
             case type-kind-real
                 return (UAtom (sc_const_real_extract value))
             default;

          
@@ 1283,84 1315,127 @@ fn... ueval (env : UAtom, expr : UAtom)
 ################################################################################
 
 let filewriter =
-    inline (data size file)
-        let ok? = ('write file data size)
-        assert ok?
+    inline (data size file lut lutsize)
+        let ok? =
+            'write file data size
+        assert ok? "write failed"
+
+let hashfilewriter =
+    inline (data size file lut lutsize)
+        let ok? =
+            do
+                assert (size == (sizeof SHA256.DigestType))
+                let key = (@ (bitcast data @u256))
+                local index : u32 =
+                    do
+                        try (copy ('get lut key))
+                        else
+                            report "filewriter: LUT lookup error: " key
+                            0:u32
+                'write file &index (sizeof index)
+        assert ok? "hash write failed"
 
 let filereader =
-    inline (data size file)
-        let ok? = ('read file data size)
-        assert ok?
+    inline (data size file lut lutsize)
+        let ok? =
+            'read file data size
+        assert ok? "read failed"
 
-fn... pickle1 (file, value : UAtom)
-    local digest : SHA256.DigestType = ('uhash value)
-    filewriter (&digest as rawstring) (sizeof digest) file
+let hashfilereader =
+    inline (data size file lut lutsize)
+        let ok? =
+            do
+                assert (size == (sizeof SHA256.DigestType))
+                local index : u32
+                let ok? = ('read file &index (sizeof index))
+                try
+                    (@ (bitcast data (mutable @u256))) = ('get lut index)
+                    ok?
+                else
+                    report "filereader: LUT lookup error"
+                    false
+        assert ok? "hash read failed"
+
+fn... pickle1 (file, lut, lutsize, value : UAtom)
+    #local digest : SHA256.DigestType = ('uhash value)
+    #hashfilewriter (&digest as rawstring) (sizeof digest) file lut lutsize true
+    local kind : u8 = (('kind value) as integer as u8)
+    filewriter &kind (sizeof kind) file lut lutsize
 
     inline pickle-str (str)
         let sz = (countof str)
         local size : u64 = sz
-        filewriter (&size as rawstring) (sizeof size) file
-        filewriter (str as rawstring) sz file
+        filewriter (&size as rawstring) (sizeof size) file lut lutsize
+        filewriter (str as rawstring) sz file lut lutsize
 
     dispatch value
     case Number (num)
-        (Number.writer filewriter) num file
+        (Number.writer filewriter) num file lut lutsize
     case String (str)
         pickle-str str
     case Symbol (str)
         pickle-str str
     case TableLimb (limb)
-        (TableLimb.writer filewriter) limb file
+        (TableLimb.writer filewriter hashfilewriter) limb file lut lutsize
     case Table (table)
-        (Table.writer filewriter) table file
+        (Table.writer filewriter hashfilewriter) table file lut lutsize
     default;
 
-fn unpickle1 (file cache)
-    local digest : SHA256.DigestType
-    filereader (&digest as rawstring) (sizeof digest) file
+fn unpickle1 (file lut lutsize cache)
+    #local digest : SHA256.DigestType
+    #hashfilereader (&digest as rawstring) (sizeof digest) file lut lutsize true
+    local kind : u8
+    filereader &kind (sizeof kind) file lut lutsize
 
     inline unpickle-str ()
         local size : u64
-        filereader (&size as rawstring) (sizeof size) file
+        filereader (&size as rawstring) (sizeof size) file lut lutsize
         let sz = (deref size)
         local str = (String sz)
         'resize str sz
-        filereader (str as rawstring) sz file
+        filereader (str as rawstring) sz file lut lutsize
         str
 
-    let kind = (UAtom.kind-from-digest digest)
+    #let kind = (UAtom.kind-from-digest digest)
+    let kind = (kind as i32 as UAtom.Kind)
     let atom =
         switch kind
         case UAtom.Kind.None (UAtom)
         case UAtom.Kind.False (UAtom false)
         case UAtom.Kind.True (UAtom true)
         case UAtom.Kind.Number
-            local num = ((Number.reader filereader) file)
+            local num = ((Number.reader filereader) file lut lutsize)
             UAtom num
         case UAtom.Kind.String
             UAtom (unpickle-str)
         case UAtom.Kind.Symbol
             UAtom.wrap (UString (unpickle-str)) kind
         case UAtom.Kind.TableLimb
-            UAtom ((TableLimb.reader filereader) cache file)
+            UAtom ((TableLimb.reader filereader hashfilereader) cache file lut lutsize)
         case UAtom.Kind.Table
-            UAtom ((Table.reader filereader) cache file)
+            UAtom ((Table.reader filereader hashfilereader) cache file lut lutsize)
         default
             assert false "unhandled atom kind"
             unreachable;
-    assert (atom == digest)
+    #assert (atom == digest)
     atom
 
 fn... pickle (file, root : UAtom)
     local done : (Set UAtom)
+    local lutsize : u32 = 0
+    local lut : (Map u256 u32)
     va-map
         inline (value)
+            local key = ('hashbits value)
+            #report "preset LUT:" key lutsize
+            'set lut key lutsize
+            lutsize += 1
             'insert done value
         UAtom;
         UAtom false
         UAtom true
     fn recur (value ...)
-        let file done = ...
+        let file done lut lutsize = ...
         let recur = this-function
         if ('in? done value)
             return;

          
@@ 1377,9 1452,13 @@ fn... pickle (file, root : UAtom)
             recur table.values ...
         default;
         #report "pickling" ('tostring value)
-        pickle1 file value
+        pickle1 file lut lutsize value
+        local key = ('hashbits value)
+        #report "set LUT:" key lutsize
+        'set lut key lutsize
+        lutsize += 1
         ;
-    recur root file done
+    recur root file done lut lutsize
 
 fn unpickle (file)
     let cur = ('tell file)

          
@@ 1393,18 1472,28 @@ fn unpickle (file)
                     UAtom.hash-from-digest value
                 else
                     hash value
+    local lut : (Map u32 u256)
+    local lutsize : u32
     va-map
         inline (value)
+            local key = ('hashbits value)
+            #report "preset LUT:" key lutsize
+            'set lut lutsize key
+            lutsize += 1
             'insert cache value
         UAtom;
         UAtom false
         UAtom true
-    loop (root = (unpickle1 file cache))
+    loop (root = (unpickle1 file lut lutsize cache))
+        local key = ('hashbits root)
+        #report "set LUT:" key lutsize
+        'set lut lutsize key
+        lutsize += 1
         #report "unpickled" ('tostring root)
         'insert cache (copy root)
         if (('tell file) >= size)
             break root
-        let atom = (unpickle1 file cache)
+        let atom = (unpickle1 file lut lutsize cache)
         atom
 
 ###############################################################################

          
@@ 1425,10 1514,10 @@ fn testfunc ()
     let expr =
         uquote
             test "test" 1 2 3 (a b c) (: 10 true) (: d e) 3.5 (: (1 2 3) (4 5 6))
-    print
+    #print
         'tostring expr
     let tab = (expr as Table)
-    print
+    #print
         'get tab (Table.new 1 2 3)
     ;
 

          
@@ 1448,6 1537,36 @@ fn testfunc ()
                 let
                     : muladd (make-seq * +)
                     muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
 
     using import tukan.File
     let testfilepath =