real functions is real functions
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 9 Apr 2018 12:59:32 +0000 (14:59 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 9 Apr 2018 12:59:32 +0000 (14:59 +0200)
modules/language/python/module/math.scm

index 4ad8d2fa97718e13355a4033880aac7154d11af4..ef137aa434ae5ffa770e3059d83965970c4cb948 100644 (file)
                 degrees radians acosh asinh atanh cosh sinh tanh
                 erf erfc gamma lgamma e tau inf nan))
 
+(define (real! s x)
+  (if (= (imag-part x) 0)
+      (real-part x)
+      (raise ValueError "real math fkn result in complex number" s)))
+
 (define ceil
   (lambda (x)
     ((@ (guile) inexac->exact)
@@ -83,7 +88,7 @@
 (define trunc py-trunc)
 
 ;; Power and logarithms
-(define exp (@ (guile) exp))
+(define (exp x) (real! 'exp ((@ (guile) exp)) x))
 
 (define expm1
   (let ((f (pointer->procedure double
@@ -91,7 +96,7 @@
                                (list double))))
     (lambda (x) (f x))))
 
-(define log (@ (guile) log))
+(define (log x) (real! 'log ((@ (guile) log)) x))
 
 (define log1p
   (let ((f (pointer->procedure double
                                (list double))))
     (lambda (x) (f x))))
 
-(define log10 (@ (guile) log10))
+(define (log10 x) (real! 'log10 (@ (guile) log10)))
 
-(define pow expt)
+(define (pow x y) (real! 'pow ((@ (guile) expt) x y)))
 
-(define sqrt (@ (guile) sqrt))
+(define (sqrt x) (real! 'sqrt (@ (guile) sqrt)))
 
 ;; Trigs
-(define acos (@ (guile) acos))
-(define asin (@ (guile) asin))
-(define atan (@ (guile) atan))
-(define cos  (@ (guile) cos))
-(define sin  (@ (guile) sin))
-(define tan  (@ (guile) tan))
+(define (acos x) (real! 'acos ((@ (guile) acos) x)))
+(define (asin x) (real! 'asin ((@ (guile) asin) x)))
+(define (atan x) (real! 'atan ((@ (guile) atan) x)))
+(define (cos  x) (real! 'cos ( (@ (guile) cos) x)))
+(define (sin  x) (real! 'sin ( (@ (guile) sin) x)))
+(define (tan  x) (real! 'tan ( (@ (guile) tan) x)))
 
 (define atan2
   (let ((f (pointer->procedure double
     (lambda (x) (* f x))))
 
 ;; Hyperbolic funcitons
-(define acosh (@ (guile) acosh))
-(define asinh (@ (guile) asinh))
-(define atanh (@ (guile) atanh))
-(define cosh  (@ (guile) cosh))
-(define sinh  (@ (guile) sinh))
-(define tanh  (@ (guile) tanh))
+(define (acosh x) (real! 'acosh ((@ (guile) acosh) x)))
+(define (asinh x) (real! 'asinh ((@ (guile) asinh) x)))
+(define (atanh x) (real! 'atanh ((@ (guile) atanh) x)))
+(define (cosh  x) (real! 'cosh ( (@ (guile) cosh) x)))
+(define (sinh  x) (real! 'sinh ( (@ (guile) sinh) x)))
+(define (tanh  x) (real! 'tanh ( (@ (guile) tanh) x)))
 
 
 ;; Special functions