feae54018189 — Leonard Ritter a month ago
* added SHA256 module
2 files changed, 164 insertions(+), 8 deletions(-)

A => testing/test_typeschema2.sc
M tukan/SHA256.sc
A => testing/test_typeschema2.sc +134 -0
@@ 0,0 1,134 @@ 
+
+#
+    do we need a database format?
+
+    our general data model has two parts:
+
+    1. an immutable, conceptually ever-expanding table of data blobs,
+        addressable by content (content-addressable store)
+
+        which can be used to implement tries and merkle trees
+
+    2. a mutable entry point into the root data structure
+
+using import struct
+using import Map
+using import Array
+
+# declare void @llvm.memcpy.p0i8.p0i8.i64(i8* <dest>, i8* <src>,
+                                        i64 <len>, i1 <isvolatile>)
+let llvm.memcpy.p0i8.p0i8.i64 =
+    extern 'llvm.memcpy.p0i8.p0i8.i64
+        function void (mutable rawstring) rawstring i64 bool
+
+import ..tukan.use
+using import tukan.SHA256
+
+fn hex64 (value)
+    ..
+        va-map
+            inline (i)
+                hex
+                    (value >> (i * 8)) & 0xff
+            va-range 8
+
+type UPointer : SHA256.DigestType
+
+    inline... to (data : voidstar, size : usize)
+        (sha256 (data as rawstring) size) as this-type
+
+    inline __hash (self)
+        (deref ((storagecast self) @ 0)) as hash
+
+    fn __repr (self)
+        .. "@"
+            va-map hex64
+                unpack (storagecast self)
+
+    @@ memo
+    inline __== (cls T)
+        static-if (cls == T)
+            inline (a b)
+                (storagecast a) == (storagecast b)
+
+    @@ memo
+    inline __imply (cls T)
+        static-if (T == (storageof cls))
+            storagecast
+
+    @@ memo
+    inline __rimply (T cls)
+        static-if (T == (storageof cls))
+            inline (self)
+                bitcast self cls
+
+struct UBlob plain
+    size : usize
+    offset : usize
+
+    fn __repr (self)
+        .. "<UBlob["
+            dec self.size
+            "] @ "
+            dec self.offset
+            ">"
+
+struct UModule # content addressable store abstraction
+    # memory blob
+    memory : (Array u64)
+    # address to offset into memory
+    map : (Map UPointer UBlob)
+    # root address
+    root : UPointer = (undef UPointer)
+
+    inline... @ (self, blob : UBlob, T : type)
+        @ ((& (self.memory @ blob.offset)) as @T)
+
+    fn... get (self, addr : UPointer)
+        'get self.map addr
+
+    fn... insert
+    case (self, data : voidstar, size : usize)
+        let addr = (UPointer.to data size)
+        try
+            let blob = ('get self.map addr)
+            _ addr (copy blob)
+        else
+            let offset = (countof self.memory)
+            let ptr =
+                'emplace-append-many self.memory ((size + 7) // 8) 0:u64
+            llvm.memcpy.p0i8.p0i8.i64
+                &ptr as (mutable rawstring)
+                data as rawstring
+                size as i64
+                false
+            let blob =
+                UBlob
+                    size = size
+                    offset = offset
+            'set self.map addr blob
+            _ addr blob
+    case (self, data)
+        let data =
+            static-if (&? data) data
+            else
+                local data = data
+        this-function self &data (sizeof data)
+
+do
+    local module : UModule
+    let s = "Rosetta code"
+    local k = (tupleof 1 2 3)
+    let addr =
+        'insert module k
+    let blob =
+        try
+            'get module addr
+        else
+            error "invalid access"
+    let ptr = ('@ module blob (tuple i32 i32 i32))
+    print ptr
+    ;
+
+
+;
  No newline at end of file

          
M tukan/SHA256.sc +30 -8
@@ 1,19 1,41 @@ 
+
+using import struct
 
 using import .crypto
 
-let DigestType = (array u8 SHA256_DIGEST_LENGTH)
+unlet SHA256
+struct SHA256 plain
+    let DigestType = (array u64 4)
+    static-assert (SHA256_DIGEST_LENGTH == (sizeof DigestType))
+
+    inline __typecall (cls)
+        local self = (super-type.__typecall cls)
+        SHA256_Init &self.ctx
+        self
+
+    fn... hash
+    case (self : (mutable &this-type), data : rawstring, len : usize)
+        SHA256_Update &self.ctx (data as @u8) len
+
+    inline... digest
+    case (self : (mutable &this-type),)
+        local data : DigestType
+        SHA256_Final (&data as (mutable @u8)) &self.ctx
+        data
+    case (self : (mutable &this-type), data : (mutable &DigestType))
+        SHA256_Final (&data as (mutable @u8)) &self.ctx
+        data
+
+    ctx : SHA256_CTX
 
 inline... sha256
 case (data : rawstring, len : usize)
-    local ctx : SHA256_CTX
-    SHA256_Init &ctx
-    SHA256_Update &ctx (data as @u8) len
-    local result : DigestType
-    SHA256_Final &result &ctx
-    result
+    local sha : SHA256
+    'hash sha data len
+    'digest sha
 case (data : string,)
     this-function data ((countof data) as usize)
 
 do
-    let sha256
+    let sha256 SHA256
     locals;
  No newline at end of file