Loading init/defmfun.lisp +39 −29 Original line number Diff line number Diff line ;; Macro for defining GSL functions. ;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp ;; Time-stamp: <2010-08-11 09:07:31EDT defmfun.lisp> ;; Time-stamp: <2014-02-16 09:11:46EST defmfun.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Copyright 2008, 2009, 2010, 2014 Liam M. Healy ;; Distributed under the terms of the GNU General Public License ;; ;; This program is free software: you can redistribute it and/or modify Loading Loading @@ -33,7 +33,7 @@ ;;; the interfaces to all the specific GSL functions. ;;; Required arguments to defmfun: ;;; name The name of the function being defined in CL ;;; name The name of the function being defined in CL; if NIL, then a lambda is created. ;;; arglist The CL argument list for the function ;;; gsl-name A string or list of strings representing the name(s) of ;;; the GSL function(s) Loading Loading @@ -146,16 +146,25 @@ (expand-defmfun-defmethods name arglist gsl-name c-arguments key-args)) ((optional-args-to-switch-gsl-functions arglist gsl-name) (expand-defmfun-optional name arglist gsl-name c-arguments key-args)) ((eq definition :function) (complete-definition 'cl:defun name arglist gsl-name c-arguments key-args))) ((member definition '(nil :function)) (if name (complete-definition 'cl:defun name arglist gsl-name c-arguments key-args) (complete-definition 'cl:lambda nil arglist gsl-name c-arguments key-args)))) name gsl-name key-args)))) (defun wrap-progn (args) "Wrap the arguments in a progn." (if (rest args) #-clisp (cons 'progn args) #+clisp (append (list 'let nil) args) ; CLISP bug workaround (first args))) (defun wrap-index-export (expanded-body name gsl-name key-args) "Wrap the expanded-body with index and export if requested. Use a progn if needed." (with-defmfun-key-args key-args (let ((index-export (progn (when name (if (eq index t) (setf index name)) (flet ((mapnfn (gslnm) `(map-name ',index ,gslnm))) (append Loading @@ -166,15 +175,16 @@ (mapcar #'mapnfn gsl-name) (list (mapnfn gsl-name))))) (when export `((export ',name)))))))) `(let () ; no progn here because of CLISP bug ,@(if (symbolp (first expanded-body)) (list expanded-body) expanded-body) ,@(make-defmcallbacks (wrap-progn (append (if (symbolp (first expanded-body)) (list expanded-body) expanded-body) (make-defmcallbacks cbinfo (second callback-dynamic-variables) (first callback-dynamic-variables)) #+fsbv ,@fsbv-functions ,@index-export)))) fsbv-functions index-export))))) ;;;;**************************************************************************** ;;;; A method for a generic function, on any class Loading Loading
init/defmfun.lisp +39 −29 Original line number Diff line number Diff line ;; Macro for defining GSL functions. ;; Liam Healy 2008-04-16 20:49:50EDT defmfun.lisp ;; Time-stamp: <2010-08-11 09:07:31EDT defmfun.lisp> ;; Time-stamp: <2014-02-16 09:11:46EST defmfun.lisp> ;; ;; Copyright 2009 Liam M. Healy ;; Copyright 2008, 2009, 2010, 2014 Liam M. Healy ;; Distributed under the terms of the GNU General Public License ;; ;; This program is free software: you can redistribute it and/or modify Loading Loading @@ -33,7 +33,7 @@ ;;; the interfaces to all the specific GSL functions. ;;; Required arguments to defmfun: ;;; name The name of the function being defined in CL ;;; name The name of the function being defined in CL; if NIL, then a lambda is created. ;;; arglist The CL argument list for the function ;;; gsl-name A string or list of strings representing the name(s) of ;;; the GSL function(s) Loading Loading @@ -146,16 +146,25 @@ (expand-defmfun-defmethods name arglist gsl-name c-arguments key-args)) ((optional-args-to-switch-gsl-functions arglist gsl-name) (expand-defmfun-optional name arglist gsl-name c-arguments key-args)) ((eq definition :function) (complete-definition 'cl:defun name arglist gsl-name c-arguments key-args))) ((member definition '(nil :function)) (if name (complete-definition 'cl:defun name arglist gsl-name c-arguments key-args) (complete-definition 'cl:lambda nil arglist gsl-name c-arguments key-args)))) name gsl-name key-args)))) (defun wrap-progn (args) "Wrap the arguments in a progn." (if (rest args) #-clisp (cons 'progn args) #+clisp (append (list 'let nil) args) ; CLISP bug workaround (first args))) (defun wrap-index-export (expanded-body name gsl-name key-args) "Wrap the expanded-body with index and export if requested. Use a progn if needed." (with-defmfun-key-args key-args (let ((index-export (progn (when name (if (eq index t) (setf index name)) (flet ((mapnfn (gslnm) `(map-name ',index ,gslnm))) (append Loading @@ -166,15 +175,16 @@ (mapcar #'mapnfn gsl-name) (list (mapnfn gsl-name))))) (when export `((export ',name)))))))) `(let () ; no progn here because of CLISP bug ,@(if (symbolp (first expanded-body)) (list expanded-body) expanded-body) ,@(make-defmcallbacks (wrap-progn (append (if (symbolp (first expanded-body)) (list expanded-body) expanded-body) (make-defmcallbacks cbinfo (second callback-dynamic-variables) (first callback-dynamic-variables)) #+fsbv ,@fsbv-functions ,@index-export)))) fsbv-functions index-export))))) ;;;;**************************************************************************** ;;;; A method for a generic function, on any class Loading