From 1fcf947dd34ed292bcfa493eb2b779d30021b0e0 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 14 May 2018 14:20:24 -0400
Subject: [PATCH] Complex number support

---
 include/cyclone/runtime.h | 38 ++++++++++++++++++++++++++++++++++++++
 scheme/inexact.sld        | 26 ++++++++++++++------------
 2 files changed, 52 insertions(+), 12 deletions(-)

diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h
index 4898870e..690cb0b2 100644
--- a/include/cyclone/runtime.h
+++ b/include/cyclone/runtime.h
@@ -311,6 +311,44 @@ void Cyc_io_read_token(void *data, object cont, object port);
   } \
   return_closcall1(data, cont, &d)
 
+#define return_inexact_double_or_cplx_op_no_cps(data, ptr, OP, CPLX_OP, z) \
+  double unboxed; \
+  Cyc_check_num(data, z); \
+  if (obj_is_int(z)) { \
+    unboxed = OP(obj_obj2int(z)); \
+  } else if (type_of(z) == integer_tag) { \
+    unboxed = OP(((integer_type *)z)->value); \
+  } else if (type_of(z) == bignum_tag) { \
+    unboxed = OP(mp_get_double(&bignum_value(z))); \
+  } else if (type_of(z) == complex_num_tag) { \
+    double complex unboxed = CPLX_OP(complex_num_value(z)); \
+    assign_complex_num(ptr, unboxed); \
+    return ptr; \
+  } else { \
+    unboxed = OP(((double_type *)z)->value); \
+  } \
+  assign_double(ptr, unboxed); \
+  return ptr;
+
+#define return_inexact_double_or_cplx_op(data, cont, OP, CPLX_OP, z) \
+  make_double(d, 0.0); \
+  Cyc_check_num(data, z); \
+  if (obj_is_int(z)) { \
+    d.value = OP(obj_obj2int(z)); \
+  } else if (type_of(z) == integer_tag) { \
+    d.value = OP(((integer_type *)z)->value); \
+  } else if (type_of(z) == bignum_tag) { \
+    d.value = OP(mp_get_double(&bignum_value(z))); \
+  } else if (type_of(z) == complex_num_tag) { \
+    complex_num_type cn; \
+    double complex unboxed = CPLX_OP(complex_num_value(z)); \
+    assign_complex_num((&cn), unboxed); \
+    return_closcall1(data, cont, &cn); \
+  } else { \
+    d.value = OP(((double_type *)z)->value); \
+  } \
+  return_closcall1(data, cont, &d)
+
 #define return_exact_double_op(data, cont, OP, z) \
   int i = 0; \
   Cyc_check_num(data, z); \
diff --git a/scheme/inexact.sld b/scheme/inexact.sld
index 11db3320..353eec8b 100644
--- a/scheme/inexact.sld
+++ b/scheme/inexact.sld
@@ -27,14 +27,16 @@
       (er-macro-transformer
         (lambda (expr rename compare)
           (let* ((fnc (cadr expr))
-                 (op (caddr expr)))
+                 (op (caddr expr))
+                 (complex-op (cadddr expr))
+                )
            `(define-c ,fnc
               "(void *data, int argc, closure _, object k, object z)"
               ,(string-append
-                " return_inexact_double_op(data, k, " op ", z);")
+                " return_inexact_double_or_cplx_op(data, k, " op ", " complex-op ", z);")
               "(void *data, object ptr, object z)"
               ,(string-append
-                " return_inexact_double_op_no_cps(data, ptr, " op ", z);"))))))
+                " return_inexact_double_or_cplx_op_no_cps(data, ptr, " op ", " complex-op ", z);"))))))
 
     (define-c nan?
       "(void *data, int argc, closure _, object k, object z)"
@@ -65,13 +67,13 @@
           (c-log z1)
           (let ((z2* (car z2)))
             (/ (c-log z1) (c-log z2*)))))
-    (define-inexact-op c-log "log")
-    (define-inexact-op exp "exp")
-    (define-inexact-op sqrt "sqrt")
-    (define-inexact-op sin "sin")
-    (define-inexact-op cos "cos")
-    (define-inexact-op tan "tan")
-    (define-inexact-op asin "asin")
-    (define-inexact-op acos "acos")
-    (define-inexact-op atan "atan")
+    (define-inexact-op c-log "log"   "clog")
+    (define-inexact-op exp   "exp"   "cexp")
+    (define-inexact-op sqrt  "sqrt"  "csqrt")
+    (define-inexact-op sin   "sin"   "csin")
+    (define-inexact-op cos   "cos"   "ccos")
+    (define-inexact-op tan   "tan"   "ctan")
+    (define-inexact-op asin  "asin"  "casin")
+    (define-inexact-op acos  "acos"  "cacos")
+    (define-inexact-op atan  "atan"  "catan")
 ))