From 3cc8afbebe959aa7c43689258c160c8fe6e60574 Mon Sep 17 00:00:00 2001
From: Stefan Israelsson Tampe <stefan.itampe@gmail.com>
Date: Mon, 9 Apr 2018 14:59:32 +0200
Subject: real functions is real functions

---
 modules/language/python/module/math.scm | 39 +++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 17 deletions(-)

diff --git a/modules/language/python/module/math.scm b/modules/language/python/module/math.scm
index 4ad8d2f..ef137aa 100644
--- a/modules/language/python/module/math.scm
+++ b/modules/language/python/module/math.scm
@@ -12,6 +12,11 @@
 		 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
@@ -106,19 +111,19 @@
                                (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
@@ -146,12 +151,12 @@
     (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
-- 
cgit v1.2.3