b5263db721eb — Leonard Ritter 3 months ago
* initial work on base encoding
3 files changed, 213 insertions(+), 48 deletions(-)

M lib/tukan/SHA256.sc
A => lib/tukan/baseN.sc
M testing/test_typeschema2.sc
M lib/tukan/SHA256.sc +50 -2
@@ 3,7 3,54 @@ using import struct
 
 using import .crypto
 
-unlet SHA256
+unlet SHA224 SHA256
+
+struct SHA224 plain
+    let DigestType = (array u32 7)
+    static-assert (SHA224_DIGEST_LENGTH == (sizeof DigestType))
+
+    inline __typecall (cls)
+        local self = (super-type.__typecall cls)
+        SHA224_Init &self.ctx
+        self
+
+    fn... hash
+    case (self : (mutable &this-type), data : rawstring, len : usize)
+        SHA224_Update &self.ctx (data as @u8) len
+
+    inline... digest
+    case (self : (mutable &this-type),)
+        local data : DigestType
+        SHA224_Final (&data as (mutable @u8)) &self.ctx
+        data
+    case (self : (mutable &this-type), data : (mutable &DigestType))
+        SHA224_Final (&data as (mutable @u8)) &self.ctx
+        data
+
+    ctx : SHA256_CTX
+
+fn... sha224-digest-string
+case (hval : (mutable &SHA224.DigestType),)
+    let sz = (SHA224_DIGEST_LENGTH * 2)
+    local str : (array i8 sz)
+    inline conv (x)
+        + x
+            ? (x < 10:i8) 48:i8 87:i8
+    for i in (range SHA224_DIGEST_LENGTH)
+        c := (deref (hval @ i)) as i8
+        i := i << 1
+        str @ i = (conv ((c >> 4:i8) & 0xf:i8))
+        str @ (i + 1) = (conv (c & 0xf:i8))
+    string &str sz
+
+inline... sha224
+case (data : rawstring, len : usize)
+    local sha : SHA224
+    'hash sha data len
+    'digest sha
+case (data : string,)
+    this-function data ((countof data) as usize)
+
 struct SHA256 plain
     let DigestType = (array u64 4)
     static-assert (SHA256_DIGEST_LENGTH == (sizeof DigestType))

          
@@ 37,5 84,6 @@ case (data : string,)
     this-function data ((countof data) as usize)
 
 do
-    let sha256 SHA256
+    let sha224 SHA224 sha256 SHA256
+    let sha224-digest-string
     locals;
  No newline at end of file

          
A => lib/tukan/baseN.sc +50 -0
@@ 0,0 1,50 @@ 
+# base58 encoding
+
+using import String
+using import itertools
+
+let BASE16-TABLE = "0123456789abcdef"
+assert ((countof BASE16-TABLE) == 16)
+
+let BASE64-TABLE = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
+assert ((countof BASE64-TABLE) == 64)
+
+inline gen-encoder (table tablesize bitstype readN writeN)
+    fn... base-encode (data : rawstring, datasize : usize)
+        local result : String
+        loop (i = datasize)
+            if (i == 0)
+                break;
+            i := i - 1
+            # read
+            let nexti = (max 0:usize (i - readN))
+            let bits = 
+                loop (i bits = i (nullof bitstype))
+                    if (i == nexti)
+                        break bits
+                    print "r"
+                    ch := (data @ i) as bitstype
+                    _ (i - 1) (bits + (ch << ((i - nexti + 1) * 8) as bitstype) as bitstype)
+            # write
+            fold (bits = bits) for k in (range writeN)
+                let bits ch =
+                    bits // tablesize
+                    bits % tablesize
+                print "w"
+                'append result
+                    table @ ch
+                bits
+            nexti
+        result
+
+let base64-encode = (gen-encoder BASE64-TABLE 64 i32 3 4)
+
+if main-module?
+    let s = "any carnal pleasure."
+    #let s = "Man" # TFWu
+    print
+        base64-encode (s as rawstring) (countof s)  
+
+    #YW55IGNhcm5hbCBwbGVhc3VyZS4=
+
+;
  No newline at end of file

          
M testing/test_typeschema2.sc +113 -46
@@ 25,26 25,29 @@ let llvm.memcpy.p0i8.p0i8.i64 =
 import ..lib.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
+struct UPointer plain
+    digest : SHA224.DigestType
+    head : i32
 
     inline... to (data : voidstar, size : usize)
-        (sha256 (data as rawstring) size) as this-type
+        local sha : SHA224
+        'hash sha (data as rawstring) size
+        local result : this-type
+        result.head = -1
+        'digest sha result.digest
+        result
 
     inline __hash (self)
-        (deref ((storagecast self) @ 0)) as hash
+        as 
+            bor
+                (self.digest @ 0) as u64
+                ((self.digest @ 1) as u64) << 32
+            hash
 
     fn __repr (self)
+        local content = self.digest
         .. "@"
-            va-map hex64
-                unpack (storagecast self)
+            sha224-digest-string content
 
     @@ memo
     inline __== (cls T)

          
@@ 75,17 78,15 @@ struct UBlob plain
             ">"
 
 struct UStore # content addressable store abstraction
-    # memory blob
-    memory : (Array u64)
-    # address to offset into memory
-    map : (Map UPointer UBlob)
+    let ChunkType = u64
+    let ChunkTypeSize = (sizeof ChunkType)
+    
     # root address
     root : UPointer = (undef UPointer)
-
-    inline... @ (self, addr : UPointer, T : type)
-        blob := ('get self.map addr)
-        ptr := (& (self.memory @ blob.offset))
-        @ (ptr as @T)
+    # address to offset into memory
+    map : (Map UPointer UBlob)
+    # memory blob
+    memory : (Array ChunkType)
 
     fn... insert
     case (self, data : voidstar, size : usize)

          
@@ 95,10 96,14 @@ struct UStore # content addressable stor
             _ addr (copy blob)
         else
             let offset = (countof self.memory)
-            let ptr =
-                'emplace-append-many self.memory ((size + 7) // 8) 0:u64
+            numblocks := ((size + ChunkTypeSize - 1) // ChunkTypeSize)
+            #'append-slots self.memory numblocks
+            #'emplace-append-many self.memory numblocks 0xdeadbeef:u64
+            for i in (range numblocks)
+                'append self.memory 0xdeadbeef:u64
+            ptr := (& (self.memory @ offset))
             llvm.memcpy.p0i8.p0i8.i64
-                &ptr as (mutable rawstring)
+                ptr as (mutable rawstring)
                 data as rawstring
                 size as i64
                 false

          
@@ 107,10 112,10 @@ struct UStore # content addressable stor
                     size = size
                     offset = offset
             'set self.map addr blob
-            do
-                ptr := (& (self.memory @ blob.offset))
-                let revaddr = (UPointer.to ptr blob.size)
-                print "insert" addr revaddr
+            #do
+                ptr := (& (self.memory @ offset))
+                let revaddr = (UPointer.to ptr size)
+                #assert (addr == revaddr)
             _ addr blob
     case (self, str : string)
         this-function self (str as rawstring) (countof str)

          
@@ 122,60 127,119 @@ struct UStore # content addressable stor
                 local data = data
         this-function self &data (sizeof data)
 
+    inline... @ (self, addr : UPointer, T : type)
+        blob := ('get self.map addr)
+        ptr := (& (self.memory @ blob.offset))
+        @ (ptr as @T)
+
 global module : UStore
 
+#
+    types are schemas which specify the layout of the specified memory as well as
+    addressing methods
+
+enum TypeKind : u8
+    Unknown = 0
+    Integer = 1
+    Real = 2
+    Ref256 = 3
+    Array = 4
+    Tuple = 5
+    Function = 6
+    Qualify = 7
+    Typename = 8
+
 inline intern-string (s)
     let addr = ('insert module s)
     global interned-string = addr
     interned-string
 
-let ref-type-name = (intern-string "ref256")
-let integer-type-name = (intern-string "integer")
-let real-type-name = (intern-string "real")
+print
+    UPointer.to ("The quick brown fox jumps over the lazy dog" as rawstring) 0
 
 inline verify-sizeof (size)
     inline (T)
+        #static-assert ((alignof T) == 8)
+            .. "(alignof " (tostring T) ") != 8"
         static-assert ((sizeof T) == size)
-            .. "(sizeof " (tostring T) ") != " (tostring size)
+            .. "(sizeof " (tostring T) ") == " 
+                \ (tostring (sizeof T)) " != " (tostring size)
         T
 
-#@@ verify-sizeof 36
+@@ verify-sizeof 16
 struct NumberType plain
-    name : UPointer
-    bitcount : i32
+    kind : TypeKind
+    bitcount : i64
 
-fn... number-type (name : UPointer, bitcount : i32,)
+fn... number-type (kind : TypeKind, bitcount : i32,)
     _
         'insert module
-            NumberType name bitcount
+            NumberType kind bitcount
         ;
 
 inline integer-type (bitcount)
-    number-type integer-type-name bitcount
+    number-type TypeKind.Integer bitcount
 
 inline real-type (bitcount)
-    number-type real-type-name bitcount
+    number-type TypeKind.Real bitcount
 
 inline bitcountof (T)
     try
         let ptr = ('@ module T NumberType)
         deref ptr.bitcount
-    else 0
+    else 0:i64
 
 global i32-type = (integer-type 32)
-global f32-type = (real-type 32)
+global u32-type = (integer-type 32)
+global float-type = (real-type 32)
 
-#@@ verify-sizeof 64
+@@ verify-sizeof 36
 struct UPointerType plain
-    name : UPointer
+    kind : TypeKind
     element : UPointer
 
 fn... pointer-type (element : UPointer,)
     _
         'insert module
-            UPointerType ref-type-name element
+            UPointerType TypeKind.Ref256 element
+        ;
+
+@@ verify-sizeof 48
+struct ArrayType plain
+    kind : TypeKind
+    element : UPointer
+    count : u64
+
+fn... array-type (element : UPointer, count : u64)
+    _
+        'insert module
+            ArrayType TypeKind.Array element count
         ;
 
+let MaxNodes = 8
+struct UPTreeHeader plain
+    count : u64
+    root : UPointer
+    tail : UPointer
+
+struct UPTreeNode plain
+    nodes : (array UPointer MaxNodes)
+
+fn empty-uptree ()
+    _
+        'insert module
+            UPTreeHeader 0 (nullof UPointer) (nullof UPointer)
+        ;
+
+global empty-uptree = (empty-uptree)
+
+fn insert-uptree (header element...)
+    'insert module
+        UPTreeNode
+
+
+print empty-uptree
+
 print
     integer-type 32
     bitcountof

          
@@ 185,12 249,15 @@ print
         integer-type 32
 
 print
-    integer-type 32
+    i32-type
     bitcountof
         integer-type 32
 print
     real-type 32
 
+print
+    array-type i32-type 16
+
 #
     untyped
     type.typename <module-uri:StringId> <name:StringId> <super-type:TypeId> <storage-type:TypeId> <memoized-value:Any> ...