ffi macro cleanup

unified interface for subsystem macros

Author: shirok

ext/ffi/ffi.scm

@@ -143,15 +143,20 @@
                   :c-name ,(cgen-safe-name-friendly (x->string name))
                   :arg-types (map %resolve-typespec ,arg-types-expr)
                   :return-type (%resolve-typespec ,rettype-expr)))]))
+        ;; cfn-specs is ((name . cfn-expr) ...), where name is a symbol
+        ;; name of cfn, and cfn-expr is (make <foreivn-c-function> ...)
+        ;; constructed above.  The subsystem macro should rearrange
+        ;; cfn-specs so that cfn-expr is evaluated in proper context.
         (let* ([ordered-cfns  (reverse cfns)]
-               [cfn-names     (map cadr ordered-cfns)]
-               [cfn-list-expr (quasirename r
-                                `(list ,@(map make-cfn-expr ordered-cfns)))])
+               [cfn-specs     (map (^[cfn]
+                                     (cons (cadr cfn) ; name
+                                           (make-cfn-expr cfn))) ;expr
+                                   ordered-cfns)])
           (ecase subsystem
             [(:stubgen)
              (quasirename r
-               `(with-stubgen-ffi ,dlo-expr ,options ,cfn-list-expr ,forms))]
+               `(with-stubgen-ffi ,dlo-expr ,options ,cfn-specs ,forms))]
             [(:native)
              (quasirename r
-               `(with-native-ffi ,dlo-expr ,options ,cfn-list-expr ,cfn-names ,forms))]
+               `(with-native-ffi ,dlo-expr ,options ,cfn-specs ,forms))]
             ))]))))

ext/ffi/ffi/native.scm

@@ -57,22 +57,21 @@
   (er-macro-transformer
    (^[f r c]
      (match f
-       [(_ dlo-expr options cfn-list-expr cfn-names forms)
+       [(_ dlo-expr options cfn-specs forms)
         (quasirename r
           `(begin
-             ,@(map (^[name] (quasirename r
-                               `(define ,name)))
-                    cfn-names)
+             ,@(map (^[spec] (quasirename r
+                               `(define ,(car spec))))
+                    cfn-specs)
              (define _dummy
-               (let ([dlo ,dlo-expr]
-                     [cfns ,cfn-list-expr])
-                 ,@(map (^[i name]
+               (let ([dlo ,dlo-expr])
+                 ,@(map (^[spec]
                           (quasirename r
-                            `(set! ,name
-                                   (make-native-ffi-proc dlo (list-ref cfns ,i)))))
-                        (iota (length cfn-names))
-                        cfn-names)))
+                            `(set! ,(car spec)
+                                   (make-native-ffi-proc dlo ,(cdr spec)))))
+                        cfn-specs)))
              ,@forms))]))))
+
 ;;;
 ;;; Type canonicalization
 ;;;

ext/ffi/ffi/stubgen.scm

@@ -49,14 +49,17 @@
   (er-macro-transformer
    (^[f r c]
      (match f
-       [(_ dlo-expr options cfn-list-expr body)
-        (quasirename r
-          `(begin
-             (define _dummy
-               (compile-and-link-ffi-stub ,dlo-expr
-                                          ,cfn-list-expr
-                                          (current-module)))
-             ,@body))]))))
+       [(_ dlo-expr options cfn-specs body)
+        (let1 cfn-list-expr
+            (quasirename r
+              `(list ,@(map cdr cfn-specs)))
+          (quasirename r
+            `(begin
+               (define _dummy
+                 (compile-and-link-ffi-stub ,dlo-expr
+                                            ,cfn-list-expr
+                                            (current-module)))
+               ,@body)))]))))
 
 (define (compile-and-link-ffi-stub dlobj cfn-instances mod)
   (let ([unit (generate-ffi-c-code-unit cfn-instances)])