7b0ae812bb49 — Leonard Ritter a month ago
* number wrapper
2 files changed, 174 insertions(+), 7 deletions(-)

M lib/tukan/libbf.sc
M testing/test_uvm3.sc
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;