M lib/tukan/libbf.sc +2 -0
@@ 22,6 22,7 @@ do
fn bf_neg (r)
r.sign ^= 1
;
+ let bf_neg = (static-typify bf_neg (mutable @bf_t))
fn bf_realloc (s ptr size)
s.realloc_func s.realloc_opaque ptr size
@@ 31,6 32,7 @@ do
# we accept to delete a zeroed bf_t structure
if ((s != null) & (tab != null))
bf_realloc s tab 0
+ let bf_delete = (static-typify bf_delete (mutable @bf_t))
#
/* 'size' must be != 0 */
M testing/test_uvm3.sc +172 -7
@@ 7,6 7,7 @@ using import String
import ..lib.tukan.use
using import tukan.libbf
using import tukan.thread
+using import tukan.SHA256
# Number
###############################################################################
@@ 27,19 28,180 @@ struct NumberContext
self
fn __drop (self)
- print "drop!"
+ bf_context_end &self.ctx
+ ;
-global number_context =
+global _number_context =
LocalStorage
fn () (NumberContext)
+inline bfcontext ()
+ & ((@ _number_context) . ctx)
+unlet _number_context
-#fn get_context ()
+type Number :: (storageof bf_t)
+
+ let DEFAULT_PREC = 56
+ let CType = @bf_t
+ let MutableCType = (mutable @bf_t)
+
+ inline... set
+ case (self)
+ bf_set_zero self 0
+ case (self, value : Nothing)
+ case (self, value : i64)
+ bf_set_si self value
+ case (self, value : u64)
+ bf_set_ui self value
+ case (self, value : integer)
+ bf_set_si self value
+ case (self, value : real)
+ bf_set_float64 self value
+ case (self, value : this-type)
+ bf_set self value
+
+ inline __typecall (cls ...)
+ local self : bf_t
+ bf_init (bfcontext) &self
+ let self = (bitcast self cls)
+ set self ...
+ self
+
+ fn __drop (self)
+ let self =
+ static-if (&? self) self
+ else (local self = self)
+ bf_delete self
+
+ inline __copy (self)
+ this-type self
+
+ fn toi32 (self)
+ local outp : i32
+ bf_get_int32 &outp self 0
+ outp
+ fn toi64 (self)
+ local outp : i64
+ bf_get_int64 &outp self 0
+ outp
+ fn tof64 (self)
+ local outp : f64
+ bf_get_float64 self &outp bf_rnd_t.BF_RNDN
+ outp
+
+ @@ memo
+ inline __as (cls T)
+ static-match T
+ case integer toi32
+ case i32 toi32
+ case i64 toi64
+ case real tof64
+ case f64 tof64
+ default;
+
+ unlet toi32 toi64 tof64
+
+ @@ memo
+ inline __imply (cls T)
+ static-if ((&? cls) and ((T == CType) or (T == MutableCType)))
+ inline (self) (& (bitcast (view self) bf_t))
+
+ @@ memo
+ inline __rimply (T cls)
+ static-if ((T < integer) or (T < real))
+ inline (self)
+ cls self
+
+ fn __repr (self)
+ local sz : u64
+ let s =
+ bf_ftoa &sz self 10 DEFAULT_PREC BF_FTOA_FORMAT_FREE_MIN
+ string s sz
-do
- print (qualifiersof (@ number_context))
+ fn cmp (self other)
+ bf_cmp self other
+
+ inline cmpfn (op)
+ @@ memo
+ inline (cls T)
+ static-if (cls == T)
+ inline (a b) (op (cmp a b) 0)
+
+ inline op0ifn (f ...)
+ inline (self)
+ let result = (this-type self)
+ f result ...
+ result
+
+ inline op1fn (f ...)
+ inline (self)
+ let result = (this-type none)
+ f result self ...
+ result
+
+ inline op2fn (f ...)
+ @@ memo
+ inline (cls T)
+ static-if (cls == T)
+ inline (a b)
+ let result = (this-type none)
+ f result (view a) (view b) ...
+ result
+
+ inline op2r2fn (f ...)
+ @@ memo
+ inline (cls T)
+ static-if (cls == T)
+ inline (a b)
+ let result1 = (this-type none)
+ let result2 = (this-type none)
+ f result1 result2 (view a) (view b) ...
+ result1
-do
- print (qualifiersof (@ number_context))
+ let
+ __== = (cmpfn ==)
+ __!= = (cmpfn !=)
+ __>= = (cmpfn >=)
+ __<= = (cmpfn <=)
+ __> = (cmpfn >)
+ __< = (cmpfn <)
+
+ let
+ __+ = (op2fn bf_add DEFAULT_PREC 0)
+ __- = (op2fn bf_sub DEFAULT_PREC 0)
+ __* = (op2fn bf_mul DEFAULT_PREC 0)
+ __/ = (op2fn bf_div DEFAULT_PREC 0)
+ __// = (op2r2fn bf_divrem DEFAULT_PREC 0 bf_rnd_t.BF_RNDZ)
+ __% = (op2fn bf_rem DEFAULT_PREC 0 bf_rnd_t.BF_RNDZ)
+
+ __** = (op2fn bf_pow DEFAULT_PREC 0)
+ atan2 = (op2fn bf_atan2 DEFAULT_PREC 0)
+
+ __| = (op2fn bf_logic_or)
+ __^ = (op2fn bf_logic_xor)
+ __& = (op2fn bf_logic_and)
+
+ let __neg = (op0ifn bf_neg)
+
+ let
+ sqrt = (op1fn bf_sqrt DEFAULT_PREC 0)
+ exp = (op1fn bf_exp DEFAULT_PREC 0)
+ log = (op1fn bf_log DEFAULT_PREC 0)
+ cos = (op1fn bf_cos DEFAULT_PREC 0)
+ sin = (op1fn bf_sin DEFAULT_PREC 0)
+ tan = (op1fn bf_tan DEFAULT_PREC 0)
+ atan = (op1fn bf_atan DEFAULT_PREC 0)
+ asin = (op1fn bf_asin DEFAULT_PREC 0)
+ acos = (op1fn bf_acos DEFAULT_PREC 0)
+
+ floor = (op0ifn bf_rint bf_rnd_t.BF_RNDZ)
+ round = (op0ifn bf_rint bf_rnd_t.BF_RNDN)
+
+ unlet cmpfn op2fn op0ifn op1fn
+
+#do
+ print ((Number 11) // (Number 2))
+
+
#
struct Number plain
@@ 245,3 407,6 @@ do
bf_delete &bfx
raise;
+do
+ let Number
+ locals;