e130a3fa0526 — Leonard Ritter a month ago
* added support for pickling
3 files changed, 362 insertions(+), 55 deletions(-)

M lib/tukan/File.sc
M testing/test_lmdb.sc
M testing/test_uvm3.sc
M lib/tukan/File.sc +13 -0
@@ 1,5 1,6 @@ 
 
 using import struct
+using import enum
 typedef FILE
 
 let

          
@@ 32,6 33,18 @@ struct File
         super-type.__typecall this-type
             _handle = handle
 
+    inline tell (self)
+        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
+
     inline error? (self)
         ferror self._handle
 

          
M testing/test_lmdb.sc +2 -1
@@ 1,5 1,6 @@ 
 
-let db = (import ..tukan.db)
+import ..lib.tukan.use
+let db = (import tukan.db)
 
 inline dbcall (f ...)
     try (f ...)

          
M testing/test_uvm3.sc +347 -54
@@ 1,6 1,7 @@ 
 using import struct
 using import enum
 using import Map
+using import Set
 using import Array
 using import String
 using import Rc

          
@@ 10,6 11,15 @@ using import tukan.libbf
 using import tukan.thread
 using import tukan.SHA256
 
+#   features:
+    * six value types: none, bool, bigfloat, string, symbol, map
+    * a pure functional evaluator without mutation, recursion or other side effects
+    * GC free, refcount based memory management
+    * any value can be used as a key in a map
+
+    in progress:
+    * pickle/unpickle
+
 let u256 = (integer 256)
 
 ###############################################################################

          
@@ 70,6 80,8 @@ type Number :: (storageof bf_t)
         bf_set_si self value
     case (self, value : real)
         bf_set_float64 self value
+    case (self, value : &bf_t)
+        bf_set self &value
     case (self, value : this-type)
         bf_set self value
 

          
@@ 80,17 92,42 @@ type Number :: (storageof bf_t)
         set self ...
         self
 
+    @@ memo
+    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) ...
+
+    @@ memo
+    inline reader (f)
+        fn read (...)
+            local source : bf_t
+            va-map
+                inline (name)
+                    let member = (getattr source name)
+                    f (&member as rawstring) (sizeof member) ...
+                \ 'sign 'expn 'len
+            let limbT = (typeof (source.tab @ 0))
+            source.tab = (alloca-array limbT source.len)
+            f (source.tab as rawstring) ((sizeof limbT) * source.len) ...
+            this-type source
+
+    let sha-writer =
+        writer
+            inline (data size sha)
+                'hash sha data size
+
     fn uhash (self)
         viewing self
         local digest : SHA256.DigestType
         local sha : SHA256
-        let self = (bitcast self bf_t)
-        va-map
-            inline (name)
-                let member = (getattr self name)
-                'hash sha (&member as rawstring) (sizeof member)
-            \ 'sign 'expn 'len
-        'hash sha (self.tab as rawstring) ((sizeof (self.tab @ 0)) * self.len)
+        sha-writer self sha
         'digest sha digest
         digest
 

          
@@ 255,18 292,52 @@ struct TableLimb
     cells : (array UAtom ArrayCellCount)
     mask : u64 = 0 # slots used
 
-    fn... uhash (self)
+    @@ memo
+    inline writer (f)
+        fn write (self ...)
+            viewing self
+            local celldigest : SHA256.DigestType
+            va-map
+                inline (i)
+                    celldigest = ('uhash (self.cells @ i))
+                    f (&celldigest as rawstring) (sizeof celldigest) ...
+                va-range ArrayCellCount
+            local mask = self.mask
+            f (&mask as rawstring) (sizeof mask) ...
+
+    @@ memo
+    inline reader (f)
+        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) ...
+                    limb.cells @ i =
+                        do
+                            try
+                                copy
+                                    'get cache celldigest
+                            else
+                                report "TableLimb cell missing:"
+                                    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
+
+    fn uhash (self)
         viewing self
         local digest : SHA256.DigestType
         local sha : SHA256
-        local celldigest : SHA256.DigestType
-        va-map
-            inline (i)
-                celldigest = ('uhash (self.cells @ i))
-                'hash sha (&celldigest as rawstring) (sizeof celldigest)
-            va-range ArrayCellCount
-        local mask = self.mask
-        'hash sha (&mask as rawstring) (sizeof mask)
+        sha-writer self sha
         'digest sha digest
         digest
 

          
@@ 295,18 366,53 @@ struct Table
             ivalues = (copy self.ivalues)
             depth = self.depth
 
+    @@ memo
+    inline writer (f)
+        fn write (self ...)
+            viewing self
+            local memberdigest : SHA256.DigestType
+            va-map
+                inline (name)
+                    let member = (getattr self name)
+                    memberdigest = ('uhash member)
+                    f (&memberdigest as rawstring) (sizeof memberdigest) ...
+                \ 'meta 'keys 'values 'ivalues
+            local depth = self.depth
+            f (&depth as rawstring) (sizeof depth) ...
+
+    @@ memo
+    inline reader (f)
+        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) ...
+                    member =
+                        do
+                            try
+                                copy
+                                    'get cache memberdigest
+                            else
+                                report "Table member missing"
+                                    sha256-digest-string memberdigest
+                                    \ "(" (UAtom.kind-from-digest memberdigest) ")"
+                                UAtom;
+                \ 'meta 'keys 'values 'ivalues
+            f (&table.depth as rawstring) (sizeof table.depth) ...
+            table
+
+    let sha-writer =
+        writer
+            inline (data size sha)
+                'hash sha data size
+
     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)
+        sha-writer self sha
         'digest sha digest
         digest
 

          
@@ 822,7 928,16 @@ type+ UAtom
         case string
             return (value as string as UAtom)
         case Symbol
-            return (value as Symbol as UAtom)
+            let sym = (value as Symbol)
+            switch sym
+            case 'none
+                return (UAtom)
+            case 'false
+                return (false as UAtom)
+            case 'true
+                return (true as UAtom)
+            default
+                return (sym as UAtom)
         case Nothing
             return (UAtom)
         case bool

          
@@ 842,6 957,9 @@ type+ UAtom
     inline __ras (T cls)
         static-if (T == Value) from-value
 
+    fn kind-from-digest (digest)
+        (((digest @ 3) >> 60) & 0xf:u64) as i32 as Kind
+
     fn uhash (self)
         let ptr = (topointer self)
         let kind = ('kind self)

          
@@ 871,11 989,20 @@ type+ UAtom
         static-assert ((sizeof digest) == (sizeof u256))
         @ (bitcast &digest @u256)
 
+    inline hash-from-digest (digest)
+        (digest @ 3) as u64 as hash
+
+    fn __hash (self)
+        hash-from-digest ('uhash self)
+
     @@ memo
     inline __== (cls T)
         static-if (cls == T)
             inline (self other)
                 ('uhash self) == ('uhash other)
+        elseif (T == SHA256.DigestType)
+            inline (self other)
+                ('uhash self) == other
 
     spice __dispatch (self handlers...)
         let ptr = `(topointer self)

          
@@ 965,11 1092,16 @@ type+ UAtom
                     inline (index node str count)
                         if (count > 0)
                             'append str " "
+                        let strval = (uatom-repr node)
                         if (count != index)
+                            'append str "(: "
                             'append str
                                 default-styler style-number (tostring index)
-                            'append str "="
-                        'append str (uatom-repr node)
+                            'append str " "
+                            'append str strval
+                            'append str ")"
+                        else
+                            'append str strval
                         count += 1
             local count = 0
             f table str count

          
@@ 978,9 1110,11 @@ type+ UAtom
                     inline (key value str count)
                         if (count > 0)
                             'append str " "
+                        'append str "(: "
                         'append str (uatom-repr key)
-                        'append str "="
+                        'append str " "
                         'append str (uatom-repr value)
+                        'append str ")"
                         count += 1
             f table str count
             'append str ")"

          
@@ 1019,7 1153,11 @@ type+ UAtom
 
 run-stage;
 
-###############################################################################
+sugar uquote (expr...)
+    qq [UAtom.from-value] ([sugar-quote] (unquote-splice expr...))
+
+# Evaluation
+################################################################################
 
 let builtins global-env =
     fold (scope env = (Scope) (Table)) for name in

          
@@ 1141,6 1279,134 @@ fn... ueval (env : UAtom, expr : UAtom)
     default
         return (copy expr)
 
+# Serialization
+################################################################################
+
+let filewriter =
+    inline (data size file)
+        let ok? = ('write file data size)
+        assert ok?
+
+let filereader =
+    inline (data size file)
+        let ok? = ('read file data size)
+        assert ok?
+
+fn... pickle1 (file, value : UAtom)
+    local digest : SHA256.DigestType = ('uhash value)
+    filewriter (&digest as rawstring) (sizeof digest) file
+
+    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
+
+    dispatch value
+    case Number (num)
+        (Number.writer filewriter) num file
+    case String (str)
+        pickle-str str
+    case Symbol (str)
+        pickle-str str
+    case TableLimb (limb)
+        (TableLimb.writer filewriter) limb file
+    case Table (table)
+        (Table.writer filewriter) table file
+    default;
+
+fn unpickle1 (file cache)
+    local digest : SHA256.DigestType
+    filereader (&digest as rawstring) (sizeof digest) file
+
+    inline unpickle-str ()
+        local size : u64
+        filereader (&size as rawstring) (sizeof size) file
+        let sz = (deref size)
+        local str = (String sz)
+        'resize str sz
+        filereader (str as rawstring) sz file
+        str
+
+    let kind = (UAtom.kind-from-digest digest)
+    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)
+            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)
+        case UAtom.Kind.Table
+            UAtom ((Table.reader filereader) cache file)
+        default
+            assert false "unhandled atom kind"
+            unreachable;
+    assert (atom == digest)
+    atom
+
+fn... pickle (file, root : UAtom)
+    local done : (Set UAtom)
+    va-map
+        inline (value)
+            'insert done value
+        UAtom;
+        UAtom false
+        UAtom true
+    fn recur (value ...)
+        let file done = ...
+        let recur = this-function
+        if ('in? done value)
+            return;
+        'insert done (copy value)
+        assert ('in? done value)
+        dispatch value
+        case TableLimb (limb)
+            for value in limb.cells
+                recur value ...
+        case Table (table)
+            recur table.meta ...
+            recur table.ivalues ...
+            recur table.keys ...
+            recur table.values ...
+        default;
+        #report "pickling" ('tostring value)
+        pickle1 file value
+        ;
+    recur root file done
+
+fn unpickle (file)
+    let cur = ('tell file)
+    'seek file (end = 0)
+    let size = ('tell file)
+    'seek file cur
+    local cache :
+        Set UAtom
+            inline (value)
+                static-if ((typeof value) == SHA256.DigestType)
+                    UAtom.hash-from-digest value
+                else
+                    hash value
+    va-map
+        inline (value)
+            'insert cache value
+        UAtom;
+        UAtom false
+        UAtom true
+    loop (root = (unpickle1 file cache))
+        #report "unpickled" ('tostring root)
+        'insert cache (copy root)
+        if (('tell file) >= size)
+            break root
+        let atom = (unpickle1 file cache)
+        atom
+
 ###############################################################################
 
 #fn from-value (value)

          
@@ 1157,12 1423,8 @@ fn testfunc ()
     #print ("test" as UAtom)
 
     let expr =
-        sugar-quote
-            test "test" 1 2 3 (a b c) [d e] 3.5 (: (1 2 3) (4 5 6))
-    print 1
-    let expr =
-        UAtom.from-value expr
-    print 2
+        uquote
+            test "test" 1 2 3 (a b c) (: 10 true) (: d e) 3.5 (: (1 2 3) (4 5 6))
     print
         'tostring expr
     let tab = (expr as Table)

          
@@ 1170,26 1432,57 @@ fn testfunc ()
         'get tab (Table.new 1 2 3)
     ;
 
+    let expr =
+        uquote
+            let
+                : a 2
+                : b 2.5
+                : c 4
+                : make-seq
+                    fn (f1 f2)
+                        fn (x y z)
+                            f2 (f1 x y) z
+                : pow2
+                    fn (x)
+                        * x x
+                let
+                    : muladd (make-seq * +)
+                    muladd (pow2 c) b a
+
+    using import tukan.File
+    let testfilepath =
+        .. module-dir "/test.uvm"
+    do
+        let testfile =
+            try (File.open testfilepath "wb")
+            else
+                error
+                    .. "creating " testfilepath " failed"
+        pickle testfile expr
+    let expr2 =
+        do
+            let testfile =
+                try (File.open testfilepath "rb")
+                else
+                    error
+                        .. "opening " testfilepath " failed"
+            unpickle testfile
+
+    let env = (global-environment)
+    let result1 result2 =
+        ueval env expr
+        ueval env expr2
     print
-        'tostring
-            ueval
-                global-environment;
-                UAtom.from-value
-                    sugar-quote
-                        let
-                            : a 2
-                            : b 2.5
-                            : c 4
-                            : make-seq
-                                fn (f1 f2)
-                                    fn (x y z)
-                                        f2 (f1 x y) z
-                            : pow2
-                                fn (x)
-                                    * x x
-                            let
-                                : muladd (make-seq * +)
-                                muladd (pow2 c) b a
+        'tostring expr
+    print
+        'tostring result1
+    print
+        'tostring expr2
+    print
+        'tostring result2
+    assert (expr == expr2)
+    assert (result1 == result2)
+
 
 #
     print