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