[Chicken-users] define-macro, ffis, and the gc

[Eric Merritt]

Guys,

 I pretty new to chicken and have a few questions I hope you can help
me with. At the bottom of this message you will find a macro. The most
obvious problem with it is that its way too long. It needs to be
broken up into smaller functional pieces. However, I am not sure how
to do that in chicken, considering that functions defined in the file
are not available at compile time. What is the usual way to handle
this? seperating out the macro into other macros? My other question
revolves around chicken's gc and malloc/calloc in an ffi. Will the gc
clean up memory allocated in a foreign-lambda or does it need to
explicitly released? If the gc handles the clean up, how do you handle
issues where special actions need  to be taken to free the memory?

Thanks,
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