- `(%def-function ,names ,args
- ,@(if module (list :module module) (values))
- ,@(if returning (list :returning returning) (values)))
-
- #+(or cmu scl sbcl)
- `(%def-function ,names ,args
- ,@(if returning (list :returning returning) (values)))
- #+lispworks
- `(%def-function ,names ,(convert-lispworks-args args)
- ,@(if module (list :module module) (values))
- ,@(if returning (list :returning returning) (values)))
- #-(or cmu scl sbcl lispworks)
- (multiple-value-bind (name-pair fname lisp-name)
- (preprocess-names names)
- `(prog1
- (%def-function ,name-pair ,processed
- :module ,module :returning ,returning)
- ;(declaim (inline ,fname))
- (defun ,lisp-name ,lisp-args
- (with-foreign-objects ,out
- (values (,fname ,@(mapcar #'first args))
- ,@(mapcar #'(lambda (arg)
- (list 'deref-pointer
- (first arg)
- (second arg))) out))))))
- )))
-
+ `(%def-function ,names ,args
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+
+ #+(or cmu scl sbcl)
+ `(%def-function ,names ,args
+ ,@(if returning (list :returning returning) (values)))
+ #+(or lispworks5 lispworks6)
+ (multiple-value-bind (name-pair fname lisp-name)
+ (preprocess-names names)
+ `(progn
+ (%def-function ,name-pair ,(convert-lispworks-args args)
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+ (defun ,lisp-name ,lisp-args
+ (,fname ,@(mapcar
+ #'(lambda (arg)
+ (cond ((member (first arg) lisp-args)
+ (first arg))
+ ((member (first arg) out :key #'first)
+ t)))
+ args)))))
+ #+(and lispworks (not lispworks5) (not lispworks 6))
+ `(%def-function ,names ,(convert-lispworks-args args)
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+ #-(or cmu scl sbcl lispworks)
+ (multiple-value-bind (name-pair fname lisp-name)
+ (preprocess-names names)
+ `(progn
+ (%def-function ,name-pair ,processed
+ :module ,module :returning ,returning)
+ ;(declaim (inline ,fname))
+ (defun ,lisp-name ,lisp-args
+ (with-foreign-objects ,out
+ (values (,fname ,@(mapcar #'first args))
+ ,@(mapcar #'(lambda (arg)
+ (list 'deref-pointer
+ (first arg)
+ (second arg))) out))))))
+ )))
+