[Chicken-users] define-macro, ffi, and gc

[Eric Merritt]

Guys,

 A am new to chicken and have a few questions, which I hope you will
answer. Below is a macro that I am working with. As you can see it is
way to large to be easily maintainable. However, since I you can't
call functions at compile time in scheme, I am not sure how to break
it up.  On a second note, this macro generates access code for a C
struct. It also mallocs memory for the aforementioned struct. Will
chicken's gc attempt to reclaim this memory when it is no longer in
use, or will it need to be explicitly freed? If the gc will collect it
how do you handle finalization code?


Thanks for your time,
Eric

---------------------------------------------------------------------------------------------------
(define-macro (define-foreign-struct long-name slots)
  (let* ((name (cadr long-name))
         (sname (symbol->string name))
         (type (first long-name))
         (stype (symbol->string type))
         (oname (gensym))
         (var (gensym))
         (var2 (gensym))
         (sarname (string-append sname "-array"))
         (arname (string->symbol sarname)))
    `(begin
       (define-foreign-type ,name 
         (pointer ,(string-append 
                    "" stype "")))
       (define-foreign-type ,arname
         (pointer ,name))

       (define ,(string->symbol (string-append 
                                 "make-" sname))
         (foreign-lambda* ,name ()
                          ,(string-append 
                            "return (("
                            stype " *) malloc(sizeof("
                            stype ")));")))
       (define ,(string->symbol (string-append
                                 "make-" 
                                 sarname))
         (foreign-lambda* ,arname ((,'int ,var))
                          ,(string-append
                            "return (("
                            stype "**) malloc(sizeof("
                            stype ") * "
                            (symbol->string var) 
                            "));")))
       (define ,(string->symbol (string-append
                                 sarname "-at"))
         (foreign-lambda* ,name ((,arname ,oname) (,'int ,var))
                          ,(string-append
                            "return (" (symbol->string oname)
                            "[" (symbol->string var) "]);")))

       (define ,(string->symbol (string-append
                                 sarname "-at!"))
         (foreign-lambda* void ((,arname ,oname) 
                                (,'int ,var)
                                (,name ,var2))
                          ,(string-append
                            "(" (symbol->string oname)
                            "[" (symbol->string var) "] = " 
                            (symbol->string var2) ");")))
                            
       ,@(concatenate (map (lambda (element)
                (if (list? element)
                    (let* ((ltype (car element))
                           (lstype (symbol->string type))
                           (name-list (cadr element))
                           (var1 (gensym))
                           (svar1 (symbol->string var1))
                           (var2 (gensym))
                           (svar2 (symbol->string var2))
                           (cname 
                            (if (list? name-list)
                                (car name-list)
                                name-list))
                           (scname (symbol->string cname))
                           (scheme-name 
                            (if (list? name-list)
                                (cadr name-list)
                                name-list))
                           (sscheme-name (symbol->string scheme-name)))
                      (list 
                       `(define ,(string->symbol (string-append
                                                  sname "-"
                                                  sscheme-name))
                          (foreign-lambda* ,ltype ((,name ,var1))
                                           ,(string-append
                                             "return ("
                                             svar1 "->" scname
                                             ");")))
                       `(define ,(string->symbol (string-append
                                                  sname "-"
                                                  sscheme-name "!"))
                          (foreign-lambda* ,ltype ((,name ,var1) 
                                                   (,ltype ,var2))
                                           ,(string-append
                                             "("
                                             svar1 "->" scname
                                             " = " svar2 ");")))))            
                    (error "Invalid slot list element")))
             slots)))))
                                       
-- 
Any sufficiently complicated C or Fortran program contains an ad-hoc,
informally-specified, bug-ridden, slow implementation of half of Lisp