From 9bd5a94ec44932de7646713902f01e12b9382247 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 11 May 2020 17:43:36 -0400
Subject: [PATCH] WIP

---
 libs/cyclone/foreign.sld | 24 ++++++++++++++++++++++--
 libs/test-foreign.scm    |  6 +++---
 2 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/libs/cyclone/foreign.sld b/libs/cyclone/foreign.sld
index a136356a..127e14d7 100644
--- a/libs/cyclone/foreign.sld
+++ b/libs/cyclone/foreign.sld
@@ -173,8 +173,17 @@
     (er-macro-transformer
       (lambda (expr rename compare)
         (let* ((scm-fnc (cadr expr))
+               (scm-fnc-wrapper (gensym 'scm-fnc))
                (c-fnc (cadddr expr))
                (rv-type (caddr expr))
+               (rv-cust-type (eval `(with-handler 
+                                (lambda X #f)
+                                (hash-table-ref *foreign-types* (quote ,rv-type))
+                                )))
+               (rv-cust-convert
+                 (if (and rv-cust-type (= 3 (length rv-cust-type)))
+                     (caddr rv-cust-type)
+                     #f))
                (arg-types (cddddr expr))
                (arg-syms/unbox 
                  (map 
@@ -190,7 +199,9 @@
                  (c->scm 
                    (string-append 
                      c-fnc "(" (string-join (map cdr arg-syms/unbox) ",") ")")
-                   rv-type))
+                   (if rv-cust-type
+                       (car rv-cust-type)
+                       rv-type)))
                (return-alloc (car returns))
                (return-expr (cdr returns))
                (args (string-append
@@ -207,7 +218,16 @@
                    return-alloc
                    "return_closcall1(data, k, " return-expr ");"))
               )
-        `(define-c ,scm-fnc ,args ,body)
+        (if rv-cust-type
+           (let ((arg-syms (map (lambda (a) (gensym 'arg)) arg-types)))
+             `(begin
+                (define-c ,scm-fnc-wrapper ,args ,body)
+                (define (,scm-fnc ,@arg-syms)
+                  (,rv-cust-convert TODO: if rv-cust-convert is not #f,
+                    (,scm-fnc-wrapper ,@arg-syms)))
+              ))
+           `(define-c ,scm-fnc ,args ,body)
+        )
           ))))
   ; '(c-define scm-strlen int "strlen" string)
   ; list
diff --git a/libs/test-foreign.scm b/libs/test-foreign.scm
index 9628b183..42c5a2ad 100644
--- a/libs/test-foreign.scm
+++ b/libs/test-foreign.scm
@@ -33,9 +33,9 @@
 
 ;; Must be top-level
 
-TODO: support custom types (arg and ret) for c-define.
-      Also need to be able to support arg/ret convert optional type arguments
-      Would need to generate scheme wrappers to handle these conversions
+;TODO: support custom types (arg and ret) for c-define.
+;      Also need to be able to support arg/ret convert optional type arguments
+;      Would need to generate scheme wrappers to handle these conversions
 
 (c-define scm-strlen my-integer "strlen" string)
 ;(c-define scm-strlen "int" "strlen" string)