#|                                                              -*- Scheme -*- 
   Copyright (c) 2003 David Van Horn
   Licensed under the Academic Free License version 2.0

   C Foreign Function Interface
   dvanhorn@cs.uvm.edu

     The `c-syntax' module provides a C foreign function interface.

       * c-lambda
       * c-declare
       * c-enum
       * c-function
       * define-c-enums
       * define-c-functions

     `c-lambda' and `c-declare' are provided by MzScheme.  See Chapter 2 of
     PLT mzc: MzScheme Compiler Manual.
     http://download.plt-scheme.org/doc/203/html/mzc/index.htm

     `c-enum' is a syntax that expands to the integer value of a C
     enumerated constant when compiled.  It is built on top of `c-lambda'
     for convenience.  `c-define-enums' makes it convenient to bind many C
     enums according to a naming convention.

 HISTORY:

     09-Jul-2003
         * Added `identifier?' fender checks to the syntax.
         * Use `with-syntax' rather than quasisyntax.
         * Changed `scheme-symbol->c-enum-symbol' to 
           `scheme-symol->c-enum-string', likewise for 
           `scheme-symbol->c-function-symbol'.

     18-May-2003
         * Added c-funcion, define-c-functions.
         * Split into c-syntax & c-syntax-transformer modules.

     21-Feb-2003
         * Initial Version.  
         * This code was developed as part of the MySQL client
           library, but has been extracted here for modularity.
|#

;; `scheme-symbol->c-enum-string'
;;
;;  Usage:  (scheme-symbol->c-enum-string s) : symbol -> string
;;
;;  Maps Scheme symbols to C symbols.
;;
;;  In this case, we transform a scheme identifier by up-casing everthing
;;  and dashes go to underscores, eg. my-id -> MY_ID

;; `c-enum' Syntax
;;
;;  Usage:  (c-enum i) : identifier -> integer
;;
;;  This syntax is used to look up the value of an enumerated constant
;;  named identifier', where identifer -> identifier' is performed by
;;  the procedure `scheme-symbol->c-symbol'.
;;  In this context, it is just a helper syntax of `define-c-enums' below.

;; `c-function' Syntax
;;
;;  Usage:  (c-function identifier (parameter-type ...) return-type)
;;           -> procedure
;;
;;  Returns a procedure implemented by the C function named by applying 
;;  scheme-symbol->c-function-symbol to identifier.  The parameter and 
;;  and return type specifications are that of the c-lambda form.
;;
;;  The return procedure must be compiled before being applied.

;; `define-c-functions' Top level syntax
;;
;;  Usage:  (define-c-functions (fun-clause) ...) : identifier ... -> void
;;
;;  Binds each identifier to it's C function counterpart.  It's used to
;;  introduce a large number of c-functions into the top-level environment.

;; `define-c-enum' Top level syntax
;;
;;  Usage:  (define-c-enums i ...) : identifier ... -> void
;;
;;  Binds each identifier to it's C enum counterpart (an integer).
;;  It's used to introduce a large number of c-enum into the top-level
;;  environment.

(module c-syntax mzscheme
  (require (lib "cffi.ss" "compiler")   ;; c-lambda, c-declare syntax.
           "c-syntax-transformer.ss")
  
  ;; transformer environment bindings.
  (require-for-syntax "c-syntax-transformer.ss") 
  
  (provide (all-defined)
           (all-from "c-syntax-transformer.ss")
           (all-from (lib "cffi.ss" "compiler")))
    
  (define-syntax (c-enum stx)
    (syntax-case stx ()
      ((_ enum-name)
       (identifier? (syntax enum-name))
       (with-syntax ([str (format "___result = ~a;"
                                  (scheme-symbol->c-enum-string
                                   (syntax-e (syntax enum-name))))])
         (syntax
          ((c-lambda () int str)))))))
  
  (define-syntax (c-function stx)
    (syntax-case stx ()
      ((_ function-name (parameter-types ...) return-type)
       (identifier? (syntax function-name))
       (with-syntax ([f (scheme-symbol->c-function-string
                         (syntax-e (syntax function-name)))])
         (syntax 
          (c-lambda (parameter-types ...) return-type f))))))
  
  (define-syntax define-c-enums
    (syntax-rules ()
      ((_ i ...)
       (define-values (i ...)
         (values (c-enum i) ...)))))
  
  (define-syntax define-c-functions
    (syntax-rules ()
      ((_ (i (p ...) r) ...)
       (define-values (i ...)
         (values (c-function i (p ...) r) ...)))))  
    
  ) ; end of c-syntax module