r2907: *** empty log message ***

[uffi.git] / src / aggregates.cl

diff --git a/src/aggregates.cl b/src/aggregates.cl
index bdc7704a1265f69f737cb5419810289eeedd523c..83a79951ddff7ebe67e52c4ae750a72ead393199 100644 (file)
--- a/src/aggregates.cl
+++ b/src/aggregates.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: aggregates.cl,v 1.14 2002/09/30 07:51:01 kevin Exp $
+;;;; $Id: aggregates.cl,v 1.15 2002/09/30 08:50:00 kevin Exp $
 ;;;;
 ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -67,18 +67,20 @@ of the enum-name name, separator-string, and field-name"
   `(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array)))
   )
 
-(defun process-struct-fields (name fields)
+(defun process-struct-fields (name fields &optional (variant nil))
   (let (processed)
     (dolist (field fields)
-      (let ((field-name (car field))
-           (type (cadr field)))
-       (push (append (list field-name)
-                   (if (eq type :pointer-self)
-                       #+cmu `((* (alien:struct ,name)))
-                       #+mcl `((:* (:struct ,name)))
-                       #-(or cmu mcl) `((* ,name))
-                       `(,(convert-from-uffi-type type :struct))))
-                   processed)))
+      (let* ((field-name (car field))
+            (type (cadr field))
+            (def (append (list field-name)
+                         (if (eq type :pointer-self)
+                             #+cmu `((* (alien:struct ,name)))
+                             #+mcl `((:* (:struct ,name)))
+                             #-(or cmu mcl) `((* ,name))
+                             `(,(convert-from-uffi-type type :struct))))))
+       (if variant
+           (push (list def) processed)
+         (push def processed))))
     (nreverse processed)))
        
            
@@ -90,10 +92,11 @@ of the enum-name name, separator-string, and field-name"
   #+lispworks
   `(fli:define-c-struct ,name ,@(process-struct-fields name fields))
   #+(and mcl (not openmcl))
-  `(ccl:defrecord ,name ,@(process-struct-fields name fields nil))
+  `(ccl:defrecord ,name ,@(process-struct-fields name fields))
   #+openmcl
-  `(ccl::def-foreign-type nil 
-                         (:struct ,name ,@(process-struct-fields name fields nil)))
+  `(ccl::def-foreign-type
+    nil 
+    (:struct ,name ,@(process-struct-fields name fields)))
   )
 
 
@@ -184,5 +187,5 @@ of the enum-name name, separator-string, and field-name"
   `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
   #+openmcl
   `(ccl::def-foreign-type nil 
-                         (:union ,name ,@(process-struct-fields name fields nil)))
+                         (:union ,name ,@(process-struct-fields name fields)))
 )