Commit 49620a79 authored by liam's avatar liam
Browse files

Removed rewrite of defun-gsl.

git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3073 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent 45210457
......@@ -3,7 +3,7 @@
; description: Macros to interface GSL functions.
; date: Mon Mar 6 2006 - 22:35
; author: Liam M. Healy
; modified: Fri May 26 2006 - 17:41
; modified: Sat May 27 2006 - 18:43
(in-package :gsl)
......@@ -353,68 +353,3 @@ and a scaling exponent e10, such that the value is val*10^e10."
,(mapcar #'wfo-declare return-symb-type)))
(when dimbind `(let ,dimbind))))))))
;;; New hack, see notes Thu May 25 2006
;;; c-return, a symbol naming a type, (e.g. :int, :double, :void),
;;; or :error-code, :number-of-answers, :success-failure.
;;; cl-return, a list of (symbol type) to return, or default to the c-return value.
(defmacro defun-gsl-new
(cl-name arglist gsl-name c-arguments
&key (c-return :error-code)
cl-return type index export
documentation mode
check-null-pointers invalidate after)
(let ((clargs (or arglist (mapcar #'rst-symbol c-arguments))) ; arguments to CL function
(return-symb-type ; return from CL function
(or cl-return (return-symbol-type (list c-return)))))
(multiple-value-bind (cargs dimbind)
(splice-arguments c-arguments mode)
`(,(if (eq type :function) 'defun 'defmethod)
,(if mode
`(,@clargs &optional (mode :double-prec))
,@(when documentation (list documentation))
,(wrap-form ; with-foreign-object
`(let ((creturn
,@(mapcan (lambda (r) `(:pointer ,(rst-symbol r)))
,(case c-return
((:error-code :number-of-answers :success-failure) :int)
(t c-return)))))
,@(case c-return
(:void '((declare (ignore creturn))))
(if (or function method)
`((check-gsl-status creturn `(,',cl-name))) ; need args
`((check-gsl-status creturn `(,',cl-name ,,@clargs))))))
,@(when invalidate `((cl-invalidate ,@invalidate)))
,@(check-null-pointers check-null-pointers)
;;;;;;;;;;;;;;;;;;;;;;;;;; CURTAIN ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(case c-return-value
(lambda (decl seq)
`((when (> creturn ,seq) ,@(pick-result decl))))
(loop for i below (length return) collect i)))
'((success-failure creturn)))
(:return (list (wrap-arg `(creturn ,@return))))
(mapcan #'pick-result return-symb-type))))))
(when return-symb-type
,(mapcar #'wfo-declare return-symb-type)))
(when dimbind `(let ,dimbind))))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment