f54635da5ef3 — Leonard Ritter a month ago
* implemented UAtom in test_uvm3
2 files changed, 277 insertions(+), 192 deletions(-)

M lib/tukan/SHA256.sc
M testing/test_uvm3.sc
M lib/tukan/SHA256.sc +18 -1
@@ 1,4 1,5 @@ 
 
+using import String
 using import struct
 
 using import .crypto

          
@@ 41,7 42,7 @@ case (hval : (mutable &SHA224.DigestType
         i := i << 1
         str @ i = (conv ((c >> 4:i8) & 0xf:i8))
         str @ (i + 1) = (conv (c & 0xf:i8))
-    string &str sz
+    String &str sz
 
 inline... sha224
 case (data : rawstring, len : usize)

          
@@ 83,7 84,23 @@ case (data : rawstring, len : usize)
 case (data : string,)
     this-function data ((countof data) as usize)
 
+fn... sha256-digest-string
+case (hval : (mutable &SHA256.DigestType),)
+    let sz = (SHA256_DIGEST_LENGTH * 2)
+    local str : (array i8 sz)
+    inline conv (x)
+        + x
+            ? (x < 10:i8) 48:i8 87:i8
+    let hval = (bitcast &hval (@ i8))
+    for i in (range SHA256_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
+
 do
     let sha224 SHA224 sha256 SHA256
     let sha224-digest-string
+    let sha256-digest-string
     locals;
  No newline at end of file

          
M testing/test_uvm3.sc +259 -191
@@ 3,12 3,26 @@ using import enum
 using import Map
 using import Array
 using import String
+using import Rc
 
 import ..lib.tukan.use
 using import tukan.libbf
 using import tukan.thread
 using import tukan.SHA256
 
+# forward declarations
+
+###############################################################################
+
+inline verify-sizeof (size)
+    inline (T)
+        #static-assert ((alignof T) == 8)
+            .. "(alignof " (tostring T) ") != 8"
+        static-assert ((sizeof T) == size)
+            .. "(sizeof " (tostring T) ") == "
+                \ (tostring (sizeof T)) " != " (tostring size)
+        T
+
 # Number
 ###############################################################################
 

          
@@ 66,6 80,20 @@ type Number :: (storageof bf_t)
         set self ...
         self
 
+    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)
+        'digest sha digest
+        digest
+
     fn __drop (self)
         let self =
             static-if (&? self) self

          
@@ 198,215 226,255 @@ type Number :: (storageof bf_t)
 
     unlet cmpfn op2fn op0ifn op1fn
 
-#do
-    print ((Number 11) // (Number 2))
+################################################################################
 
+type UAtom :: voidstar
 
+# Table
+################################################################################
 
-#
-    struct Number plain
-        sign : i64
-        expn : i64
-        len : u64
-        tab : (array u64)
+let IndexBits = 4
+let ArrayCellCount = (1 << IndexBits)
+let IndexMask = (ArrayCellCount - 1)
 
-        let DEFAULT_PREC = 56
+@@ verify-sizeof 136
+struct TableLimb
+    cells : (array UAtom ArrayCellCount)
+    mask : u64 = 0 # slots used
 
-        fn... from_bf (n : &bf_t)
-            bufsize := (sizeof this-type) + (sizeof u64) * n.len
-            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)
-                buf.tab @ i = n.tab @ i
-            local uref = (URef.store &buf bufsize)
-            uref.kind = URef.Kind.Number
-            uref
+@@ verify-sizeof 40
+struct Table
+    meta : UAtom
+    keys : UAtom
+    values : UAtom
+    ivalues : UAtom
+    depth : u64
 
-    fn bftostr (x)
-        local sz : u64
-        let s =
-            bf_ftoa &sz x 10 Number.DEFAULT_PREC BF_FTOA_FORMAT_FREE_MIN
-        String s sz
+# UAtom
+################################################################################
+
+type UHashed < Struct
 
-    fn bftosstr (x)
-        local sz : u64
-        let s =
-            bf_ftoa &sz x 10 Number.DEFAULT_PREC BF_FTOA_FORMAT_FREE_MIN
-        string s sz
+    inline __typecall (cls ...)
+        static-if (cls == this-type)
+            let T hashf = ...
+            struct (.. "(UHashed " (tostring T) ")") < this-type
+                id : SHA256.DigestType
+                data : T
 
-    fn numbertobf (r ref)
-        let num =
-            bitcast ('load ref) (pointer Number)
-        local n =
-            bf_t
-                sign = (num.sign as i32)
-                expn = num.expn
-                len = num.len
-                tab = (bitcast (& (num.tab @ 0)) (mutable pointer u64))
-        bf_set r &n
+                let HashFunction =
+                    static-if (none? hashf)
+                        inline (self)
+                            'uhash self
+                    else hashf
+        else
+            let data = ...
+            super-type.__typecall cls
+                id = (cls.HashFunction data)
+                data = data
 
-    fn numbertostr (ref)
-        local n : bf_t
-        bf_init &bf_ctx &n
-        numbertobf &n ref
-        let str = (bftostr &n)
-        bf_delete &n
-        str
-
-    fn numbertosstr (ref)
-        local n : bf_t
-        bf_init &bf_ctx &n
-        numbertobf &n ref
-        let str = (bftosstr &n)
-        bf_delete &n
-        str
+    fn __repr (self)
+        viewing self
+        .. "(" (tostring (typeof self)) " " (repr self.data) ")"
 
-    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
+inline UType (T ...)
+    Rc (UHashed T ...)
+let
+    UNumber = (UType Number)
+    UString =
+        UType String
+            fn "uhash" (self)
+                viewing self
+                local digest : SHA256.DigestType
+                local sha : SHA256
+                'hash sha (self as rawstring) (countof self)
+                'digest sha digest
+                digest
+    UTableLimb = (UType TableLimb)
+    UTable = (UType Table)
 
-    inline number_op0_inplace (f ...)
-        fn (x)
-            local res : bf_t
-            bf_init &bf_ctx &res
-            numbertobf &res x
-            f &res ...
-            let result = (Number.from_bf res)
-            bf_delete &res
-            result
+type+ UAtom
+    enum Kind plain
+        None = 0
+        False
+        True
+        Number
+        String
+        Symbol
+        TableLimb
+        Table
 
-    inline number_op0 (f ...)
-        fn ()
-            local res : bf_t
-            bf_init &bf_ctx &res
-            f &res ...
-            let result = (Number.from_bf res)
-            bf_delete &res
-            result
+    inline __typecall (cls value)
+        imply value cls
+
+    @@ memo
+    inline __rimply (T cls)
+        fn wrap (ptr kind)
+            let origptr = ptr
+            let val = (ptrtoint ptr usize)
+            # no bits must be set
+            assert ((val & 0xf:usize) == 0:usize)
+            let ptr = (inttoptr (val | (kind as integer as usize)) voidstar)
+            let self = (dupe (bitcast ptr this-type))
+            lose origptr
+            self
 
-    inline number_op1 (f ...)
-        fn (x)
-            local bfx : bf_t
-            bf_init &bf_ctx &bfx
-            numbertobf &bfx x
-            local res : bf_t
-            bf_init &bf_ctx &res
-            f &res &bfx ...
-            let result = (Number.from_bf res)
-            bf_delete &bfx
-            bf_delete &res
-            result
+        static-if (T == bool)
+            inline (self)
+                wrap null
+                    ? self Kind.True Kind.False
+        elseif (imply? T Number)
+            inline (self)
+                self := (imply self Number)
+                wrap (UNumber self) Kind.Number
+        elseif (T == Symbol)
+            inline (self)
+                wrap (UString (String (self as string))) Kind.Symbol
+        elseif (T == TableLimb)
+            inline (self)
+                wrap (UTableLimb self) Kind.TableLimb
+        elseif (T == Table)
+            inline (self)
+                wrap (UTable self) Kind.Table
+        elseif ((imply? T String) or (T == string))
+            inline (self)
+                self := (imply self String)
+                wrap (UString self) Kind.String
+        elseif (T == Nothing)
+            inline (self)
+                wrap null Kind.None
+
+    fn topointer (self)
+        viewing self
+        inttoptr ((ptrtoint (storagecast self) usize) & (~ 0xf:usize)) voidstar
 
-    inline number_op2 (f ...)
-        fn (a b)
-            local bfa : bf_t
-            local bfb : bf_t
-            bf_init &bf_ctx &bfa
-            bf_init &bf_ctx &bfb
-            numbertobf &bfa a
-            numbertobf &bfb b
-            local res : bf_t
-            bf_init &bf_ctx &res
-            f &res &bfa &bfb ...
-            let result = (Number.from_bf res)
-            bf_delete &bfa
-            bf_delete &bfb
-            bf_delete &res
-            result
+    fn kind (self)
+        viewing self
+        ((ptrtoint (storagecast self) usize) & 0xf) as (storageof Kind) as Kind
 
-    fn number-cmp (a b)
-        local bfa : bf_t
-        local bfb : bf_t
-        bf_init &bf_ctx &bfa
-        bf_init &bf_ctx &bfb
-        numbertobf &bfa a
-        numbertobf &bfb b
-        let result = (bf_cmp &bfa &bfb)
-        bf_delete bfa
-        bf_delete bfb
-        result
+    fn uhash (self)
+        let ptr = (topointer self)
+        let kind = ('kind self)
+        let digest =
+            switch kind
+            case Kind.Number
+                copy ((bitcast ptr UNumber) . id)
+            pass Kind.Symbol
+            pass Kind.String
+            do
+                copy ((bitcast ptr UString) . id)
+            case Kind.TableLimb
+                copy ((bitcast ptr UTableLimb) . id)
+            case Kind.Table
+                copy ((bitcast ptr UTable) . id)
+            default
+                nullof SHA256.DigestType
+        # embed kind bits into digest
+        insertvalue digest
+            ((digest @ 0) & (~ 0xf:u64)) | (kind as integer)
+            0
 
-    let number-const-log2 = (number_op0 bf_const_log2 Number.DEFAULT_PREC 0)
-    let number-const-pi = (number_op0 bf_const_pi Number.DEFAULT_PREC 0)
-
-    let number-toint = (number_op0_inplace bf_rint bf_rnd_t.BF_RNDZ)
-    let number-neg = (number_op0_inplace bf_neg)
+    @@ memo
+    inline __== (cls T)
+        static-if (cls == T)
+            inline (self other)
+                ('uhash self) == ('uhash other)
 
-    let number-add = (number_op2 bf_add Number.DEFAULT_PREC 0)
-    let number-sub = (number_op2 bf_sub Number.DEFAULT_PREC 0)
-    let number-mul = (number_op2 bf_mul Number.DEFAULT_PREC 0)
-    let number-div = (number_op2 bf_div Number.DEFAULT_PREC 0)
-    let number-rem = (number_op2 bf_rem Number.DEFAULT_PREC 0 bf_rnd_t.BF_RNDZ)
-
-    let number-pow = (number_op2 bf_pow Number.DEFAULT_PREC 0)
-    let number-atan2 = (number_op2 bf_atan2 Number.DEFAULT_PREC 0)
-
-    let number-or = (number_op2 bf_logic_or)
-    let number-xor = (number_op2 bf_logic_xor)
-    let number-and = (number_op2 bf_logic_and)
-
-    let number-sqrt = (number_op1 bf_sqrt Number.DEFAULT_PREC 0)
-    let number-exp = (number_op1 bf_exp Number.DEFAULT_PREC 0)
-    let number-log = (number_op1 bf_log Number.DEFAULT_PREC 0)
-    let number-pow = (number_op1 bf_pow Number.DEFAULT_PREC 0)
-    let number-cos = (number_op1 bf_cos Number.DEFAULT_PREC 0)
-    let number-sin = (number_op1 bf_sin Number.DEFAULT_PREC 0)
-    let number-tan = (number_op1 bf_tan Number.DEFAULT_PREC 0)
-    let number-atan = (number_op1 bf_atan Number.DEFAULT_PREC 0)
-    let number-asin = (number_op1 bf_asin Number.DEFAULT_PREC 0)
-    let number-acos = (number_op1 bf_acos Number.DEFAULT_PREC 0)
-
-    fn number-int? (x)
-        (number-cmp x (number-toint x)) == 0
+    spice __dispatch (self handlers...)
+        let ptr = `(topointer self)
+        let tag = `('kind self)
+        let sw = (sc_switch_new tag)
+        for arg in ('args handlers...)
+            let anchor = ('anchor arg)
+            let key arg = ('dekey arg)
+            if (key == unnamed)
+                sc_switch_append_default sw `(arg)
+            else
+                let lit = ('@ Kind key)
+                let val = (lit as Kind)
+                inline append-case (...)
+                    sc_switch_append_case sw lit ('tag `(arg ...) anchor)
+                switch val
+                case Kind.Number
+                    append-case `((bitcast ptr UNumber) . data)
+                pass Kind.String
+                pass Kind.Symbol
+                do
+                    append-case `((bitcast ptr UString) . data)
+                case Kind.TableLimb
+                    append-case `((bitcast ptr UTableLimb) . data)
+                case Kind.Table
+                    append-case `((bitcast ptr UTable) . data)
+                default
+                    append-case;
+        spice-quote
+            do ptr
+                sw
 
-    fn number-get-u64 (x)
-        local bfx : bf_t
-        bf_init &bf_ctx &bfx
-        try
-            numbertobf &bfx x
-        else
-            bf_delete &bfx
-            raise;
+    @@ spice-quote
+    fn __repr (self)
+        .. "(UAtom "
+            dispatch self
+            case None () "none"
+            case False () "false"
+            case True () "true"
+            case Number (n) (repr n)
+            case String (n) (repr (n as string))
+            case Symbol (n) (n as string)
+            case TableLimb (n)
+                local digest = ('uhash self)
+                ..
+                    tostring ('kind self)
+                    " "
+                    (sha256-digest-string digest) as string
+            case Table (n)
+                local digest = ('uhash self)
+                ..
+                    tostring ('kind self)
+                    " "
+                    (sha256-digest-string digest) as string
+            default "?"
+            ")"
 
-        local bfcmp : bf_t
-        bf_init &bf_ctx &bfcmp
-        bf_set_zero &bfcmp 0
-        if ((bf_cmp &bfx &bfcmp) >= 0)
-            bf_set_si &bfcmp 0x7fffffffffffffff:i64
-            if ((bf_cmp &bfx &bfcmp) <= 0)
-                local bfint : bf_t
-                bf_init &bf_ctx &bfint
-                bf_set &bfint &bfx
-                bf_rint &bfint bf_rnd_t.BF_RNDZ
-                if ((bf_cmp &bfx &bfint) == 0)
-                    local outp : i64
-                    bf_get_int64 &outp &bfx 0
-                    bf_delete &bfint
-                    bf_delete &bfcmp
-                    bf_delete &bfx
-                    return ((deref outp) as u64)
-                bf_delete &bfint
-        bf_delete &bfcmp
-        bf_delete &bfx
-        raise;
+    fn __drop (self)
+        viewing self
+        returning void
+        let ptr = (topointer self)
+        switch ('kind self)
+        case Kind.Number
+            __drop (bitcast ptr UNumber)
+        pass Kind.Symbol
+        pass Kind.String
+        do
+            __drop (bitcast ptr UString)
+        case Kind.TableLimb
+            __drop (bitcast ptr UTableLimb)
+        case Kind.Table
+            __drop (bitcast ptr UTable)
+        default;
+
+run-stage;
 
 do
-    let Number
-    locals;
+    let val =
+        #UAtom 303
+        UAtom "hello"
+
+    local digest = ('uhash val)
+
+    print ((UAtom true) != (UAtom true))
+
+    print val
+
+    dispatch val
+    case Number (n)
+        print n
+    default
+        print "nope"
+
+    # e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
+    #print (sha256-digest-string digest)
+    #drop val
+    ;
+
+;
  No newline at end of file