;;;;
;;;; ffi.stk			-- FFI support
;;;;
;;;; Copyright © 2007-2011 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@essi.fr]
;;;;    Creation date: 14-Bun-2007 09:24 (eg)
;;;; Last file update:  4-Dec-2011 18:10 (eg)
;;;;

(define make-external-function #f)
(define make-callback	       #f)

(let ((table '((:void 		0)
	       (:char 		1)
	       (:short 		2)
	       (:ushort 	3)
	       (:int 		4)
	       (:uint 		5)
	       (:long 		6)
	       (:ulong 		7)
	       (:lonlong	8)
	       (:ulonlong	9)
	       (:float 		10)
	       (:double 	11)
	       (:boolean 	12)
	       (:pointer 	13)
	       (:string		14)
	       (:int8		15)
	       (:int16		16)
	       (:int32		17)
	       (:int64		18)
	       (:obj		19))))

  (define (arg-type->number k argument?)
    (let ((info (assoc k table)))
      (if info
	  (let ((r (cadr info)))
	    (if (and (zero? r) argument?)
		(error 'define-external "parameter of type :void are forbidden")
		(cadr info)))
	  (error 'define-external "bad type name ~S" k))))

  (define (parse-parameters lst)
    (map (lambda (x)
	   (cond
	     ((keyword? x)
	      (arg-type->number x #t))
	     ((pair? x)
	      (if (and (symbol? (car x)) (keyword? (cadr x)) (null? (cddr x)))
		  (arg-type->number (cadr x) #t)
		  (error 'make-external-function
			 "bad parameter description: ~S" x)))
	     (else
	      (error 'make-external-function "bad parameter description: ~S" x))))
	 lst))


  ;; make-external-function
  (set! make-external-function
    (lambda (entry-name parameters return-type lib-name)
      (%make-ext-func entry-name
		      (parse-parameters parameters)
		      (arg-type->number return-type #f)
		      lib-name)))

  ;; make-callback
  (set! make-callback
    (lambda (proc types data)
      (%make-callback proc (parse-parameters types) data))))



#|
<doc EXT-SYNTAX define-external
 * (define-external name parameters option)
 *
 * The form |define-external| binds a new procedure to |name|.
 * The arity of this new procedure is defined by the typed list of
 * parameters given by |parameters|. This parameters list is a list
 * of keywords (as defined in the previous table) or couples whose first
 * element is the name of the parameter, and the second one is a type
 * keyword.  All the types defined in the above table, except
 * |:void|, are allowed for the parameters of a foreign function.
 * @linebreak
 * |Define-external| accepts several options:
 * ,(itemize
 * (item [
 * |:return-type| is used to define the type of the value returned
 * by the foreign function. The type returned must be chosen in the types specified
 * in the table. For instance:
 * @lisp
 * (define-external maximum(:int :int)
 *    :return-type :int)
 * @end lisp
 * defines the foreign function maximum which takes two C integers and
 * returns an integer result. Omitting this option default to a result
 * type equal to |:void| (i.e. the returned value is ,(emph "undefined")).
 * ])
 *
 * (item [
 * |:entry-name| is used to specify the name of the foreign
 * function in the C world. If this option is omitted, the entry-name is
 * supposed to be |name|. For instance:
 * @lisp
 * (define-external minimum((a :int) (b :int))
 *    :return-type :int
 *    :entry-name  "min")
 * @end lisp
 * defines the Scheme function |minimum| whose application
 * executes the C function called |min|.
 * ])
 * (item [
 * |:library-name| is used to specify the library which contains the
 * foreign-function. If necessary, the library is loaded before calling the
 * C function. So,
 * @lisp
 * (define-external minimum((a :int) (b :int))
 *    :return-type  :int
 *    :entry-name   "min"
 *     :library-name "libminmax")
 * @end lisp
 * defines a function which will execute the function |min|
 * located in the library |libminmax.xx| (where |xx| is the suffix used
 * for shared libraries on the running system (generally |so|))
 * ])
 * )
doc>
|#
(define-macro (define-external name parameters . args)
  (let* ((lib	     (key-get args :library-name ""))
	 (lib-name   (if (and (equal? lib "")
			      (equal? (running-os) 'cygwin-windows))
			 "cygwin1.dll"
			 lib))
	 (entry-name  (key-get args :entry-name (symbol->string name)))
	 (return-type (key-get args :return-type :void)))

    `(define ,name (make-external-function ,entry-name
					   ',parameters
					   ,return-type
					   ,lib-name))))

(provide "ffi")