7b0b77ee1e22 — Leonard Ritter a month ago
* work on UVM
3 files changed, 228 insertions(+), 145 deletions(-)

M lib/tukan/ustore.sc
M testing/test_typeschema2.sc
A => testing/test_uvm.sc
M lib/tukan/ustore.sc +77 -134
@@ 8,7 8,7 @@ using import struct
 using import enum
 using import Map
 using import Array
-using import .SHA1
+using import .SHA256
 
 # declare void @llvm.memcpy.p0i8.p0i8.i64(i8* <dest>, i8* <src>,
                                         i64 <len>, i1 <isvolatile>)

          
@@ 19,85 19,67 @@ let llvm.memcpy.p0i8.p0i8.i64 =
 enum UError
     SegmentationFault
 
-type UPointer #< integer
-    Hasher := SHA1
+enum URefKind : u32
+    Unknown = 0
+    String = 1 # utf-8 string
+    Symbol = 2 # utf-8 string
+    Number = 3 # sign, expn, len, bits...
+    Table = 4
+    TableBranch = 5
+    TableLeaf = 6
+
+struct URef plain
+    Hasher := SHA224
     DigestType := Hasher.DigestType
-    Bitcount := 32 * 8
-    DigestOffset := Bitcount - (sizeof DigestType) * 8
-    NullBitOffset := DigestOffset - 1
+    Kind := URefKind
+    
+    address : (array u32 7) =
+        arrayof u32
+            0x8c024ad1:u32
+            0xc92b3a2a:u32
+            0xbb026147:u32
+            0xc4348228:u32
+            0x1fb0a215:u32
+            0x2aa68e82:u32
+            0x2fe4b3c5:u32
+    kind : URefKind = URefKind.Unknown
 
-    inline... to (cls, data : voidstar, size : usize)
-        local result : (storageof cls)
+    fn... set (self, data : voidstar, size : usize)
+        cls := (typeof self)
         local sha : Hasher
         'hash sha (data as rawstring) size
-        'digest sha (@ (bitcast (& result) (mutable @DigestType)))
-        as
-            ((result << 1) | 1) << (DigestOffset - 1)
-            cls
-
-    @@ memo
-    inline new-type (T)
-        static-assert ((typeof T) == type)
-        type (.. "(UPointer " (tostring T) ")") < this-type : (integer Bitcount)
-            ElementType := T
-            PointerType := (pointer ElementType)
+        'digest sha (@ (bitcast (& self.address) (mutable @DigestType)))
+        ;
 
-    inline __typecall (cls ...)
-        static-if (cls == this-type)
-            new-type ...
-        else
-            nullof cls
-
-    unlet new-type
-
-    inline __hash (self)
-        ((storagecast self) >> DigestOffset) as u64
-
-    fn null? (self)
-        self == (nullof (typeof self))
-
-    fn __tobool (self)
-        not (null? self)
+    inline... to (cls, data : voidstar, size : usize)
+        local self : cls
+        set self data size
+        self
 
     fn __repr (self)
-        if (null? self) "@null"
-        else
-            value := (storagecast self)
-            size := ((sizeof value) as i32)
-            .. "@"
-                ..
-                    va-map
-                        inline (i)
-                            i := size - 1 - i
-                            let e1 e0 =
-                                ((value >> (i * 8)) as u8) & 0xf
-                                ((value >> (i * 8 + 4)) as u8) & 0xf
-                            ..
-                                hex e0
-                                hex e1
-                        va-range size
-                ":"
-                repr (qualifiersof self)
+        values := self.address
+        .. "(URef "
+            ..
+                va-map
+                    inline (i)
+                        value := values @ i 
+                        ..
+                            va-map
+                                inline (k)
+                                    #k := 3 - k
+                                    let e1 e0 =
+                                        ((value >> (k * 8)) as u8) & 0xf
+                                        ((value >> (k * 8 + 4)) as u8) & 0xf
+                                    ..
+                                        hex e0
+                                        hex e1
+                                va-range 4
+                    va-range 7
+            " "
+            repr self.kind
+            ")"
 
-    @@ memo
-    inline __== (cls T)
-        static-if (cls == T)
-            inline (a b)
-                (storagecast a) == (storagecast b)
-
-    @@ memo
-    inline __ras (T cls)
-        static-if (T == (storageof cls))
-            inline (self)
-                bitcast self cls
-
-    @@ memo
-    inline __imply (cls T)
-        static-if ((T < this-type) and (imply? cls.PointerType T.PointerType))
-            inline (self)
-                bitcast self T
-
-let uvoidstar = (UPointer void)
+run-stage;
 
 struct UMemory plain
     ptr : voidstar

          
@@ 122,18 104,23 @@ struct UMemory plain
             dec self.size
             ">"
 
+fn hasher (addr)
+    bor        
+        imply (addr @ 0) u64
+        (imply (addr @ 1) u64) << 32
+
 struct UStore # content addressable store abstraction
     WordType := u64
     WordTypeSize := (sizeof WordType)
 
     # address to offset into memory
-    map : (Map uvoidstar UMemory)
+    map : (Map URef.DigestType UMemory hasher)
 
     fn... store (self : &this-type, mem : UMemory)
         let data size = mem.ptr mem.size
-        let addr = ('to uvoidstar data size)
+        let addr = ('to URef data size)
         try
-            'get self.map addr
+            'get self.map addr.address
             ;
         else
             numblocks := ((size + WordTypeSize - 1) // WordTypeSize)

          
@@ 148,80 135,36 @@ struct UStore # content addressable stor
                 data as rawstring
                 size as i64
                 false
-            'set self.map addr
+            'set self.map addr.address
                 UMemory
                     ptr = ptr
                     size = size
         addr
 
-    fn... load (self : &this-type, addr : (typematch T < UPointer))
+    fn... load (self : &this-type, addr : URef)
         try
-            'get self.map addr
+            'get self.map addr.address
         else
             raise (UError.SegmentationFault)
 
 global g_ustore : UStore
-
-inline... uload (uptr : uvoidstar)
-    'load g_ustore uptr
-
-inline... ustore (mem : UMemory)
-    'store g_ustore mem
+'store g_ustore (UMemory null 0)
 
-type+ UPointer
-    fn __toref (self)
-        let T = (typeof self)
-        let mem = ('load g_ustore self)
-        @ (mem.ptr as T.PointerType)
-
-    fn __countof (self)
+type+ URef
+    fn load (self)
         let T = (typeof self)
         let mem = ('load g_ustore self)
-        (deref mem.size) // (sizeof T.ElementType)
+        _ mem.ptr mem.size
 
-    @@ memo
-    inline __as (cls T)
-        static-if ((T < this-type) and (as? cls.PointerType T.PointerType))
-            inline (self)
-                bitcast self T
-        elseif ((cls.ElementType == i8) and (T == string))
-            inline (self)
-                (uload self) as string
+    inline... store (ptr : voidstar, size : usize)
+        'store g_ustore (UMemory ptr size)
 
-inline... u&
-case (str : string)
-    as
-        'store g_ustore str
-        UPointer i8
-case (data)
-    let sz = (sizeof data)
-    let data =
-        static-if (&? data) data
-        else
-            local data = data
-    as
-        'store g_ustore
-            UMemory &data sz
-        UPointer (typeof data)
-
-if main-module?
-    let ptr = (u& 36)
-    report ptr
-        try (countof ptr)
-        else (unreachable)
-    report
-        try (@ ptr)
-        else (unreachable)
-    let s = "The quick brown fox jumps over the lazy dog"
-    let ptr = (u& s)
-    report
-        try (as ptr string)
-        else (unreachable)
-        countof s
-        try (countof ptr)
-        else (unreachable)
+static-if main-module?
+    try
+        print ('load (URef))
+    else
+        print "failed"
 
 do
-    let UMemory UPointer uvoidstar UError
-    let uload ustore u&
+    let UMemory URef UError
     locals;
  No newline at end of file

          
M testing/test_typeschema2.sc +85 -11
@@ 11,6 11,12 @@ 
 
     2. a mutable entry point into the root data structure
 
+
+    
+
+
+
+
 using import struct
 using import enum
 using import Map

          
@@ 107,20 113,88 @@ fn tree-levels (count)
     ? (numnodes == 0) 0
         (findmsb numnodes) + 1
 
-enum ObjectType : u64 # 3 bits
-    Empty = 0
-    None = 1 # ""
-    Boolean = 2 # "true", "false"
-    Number = 3 # sign, expn, len, bits...
-    String = 4 # string
-    Symbol = 5 # string
-    Table = 6
-    Subtable = 7
+#
+    types:
+
+    number
+    symbol
+    string
+    map
+        <type>
+        <constant> = <type>
+        <type> = <type>
+        ...
+    range <number> <number>
+    sum <constant> <type> ...
+    function
+        <constant> = <expression>
+        ...
+
+    constant:
+
+    number
+    symbol
+    string
+    map
+        <constant>
+        <constant> = <constant>
+        ...
+
+    IL:
 
-@@ verify-sizeof 520
+    expression :=
+        or
+            constant
+            map
+                <symbol>
+                <expression>
+                ...
+    at <constant>
+    <symbol>
+    do
+        <symbol> = <expression>
+        ...
+        <expression>
+    if
+        value = <expression>
+        then = <expression>
+        else = <expression> 
+    switch
+        value = <expression>
+        map = <map>
+        default = <expression>
+    get
+        map = <expression>
+        <expression>
+        <expression>
+        ...
+    set
+        map = <expression>
+        <expression>
+        <expression> = <expression>
+    map
+        <expression>
+        <expression> = <expression>
+    # apply/call
+    <expression>:function
+        <expression>
+        <expression> = <expression>
+
+#
+    ref:
+    8 bit object type
+    
+
+#
+    pointer should contain:
+        content hash
+        content size in bytes (u64)
+        object type (u8)
+
+@@ verify-sizeof 528
 struct USubtable plain
     slots : (array (UPointer void) MaxNodes)
-    types : u64
+    types : (array ObjectType MaxNodes)
 
 @@ verify-sizeof 96
 struct UTable plain

          
A => testing/test_uvm.sc +66 -0
@@ 0,0 1,66 @@ 
+using import struct
+using import enum
+using import Map
+using import Array
+
+import ..lib.tukan.use
+using import tukan.ustore
+using import tukan.libbf
+
+let realloc =
+    extern 'realloc
+        function voidstar voidstar usize
+fn urealloc (opaque ptr size)
+    realloc ptr size
+global bf_ctx : bf_context_t
+bf_context_init &bf_ctx urealloc null
+
+
+struct Number plain
+    sign : i64
+    expn : i64
+    len : u64
+    tab : (array u64)
+
+    fn... from_bf (n : &bf_t)
+        bufsize := (sizeof this-type) + (sizeof u64) * n.len
+        print n.sign n.expn n.len bufsize
+        let buf =
+            ptrtoref
+                bitcast
+                    alloca-array u8 bufsize
+                    mutable pointer this-type
+        buf.sign = n.sign
+        buf.expn = n.expn
+        buf.len = n.len
+        for i in (range n.len)
+            #print i (n.tab @ i)
+            buf.tab @ i = n.tab @ i
+        local uref = (URef.store &buf bufsize)
+        uref.kind = URef.Kind.Number
+        uref
+
+inline gen-number (f value)
+    local n : bf_t
+    bf_init &bf_ctx &n
+    f &n value
+    let uref = (Number.from_bf n)
+    bf_delete &n
+    uref
+
+fn... number (value : i64)
+    gen-number bf_set_si value
+case (value : u64)
+    gen-number bf_set_ui value
+case (value : f64)
+    gen-number bf_set_float64 value
+
+print
+    number -1
+    number 0
+    number 1
+    number 2
+    number 3.5
+
+
+;
  No newline at end of file