Commit 123ee2c4 authored by Liam M. Healy's avatar Liam M. Healy
Browse files

Make anonymous functions with defmfun

The definition of defmfun has been expanded to permit NIL as the name
of the function, in which case it is created as a lambda.
parent efcc519c
Loading
Loading
Loading
Loading
+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
@@ -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)
@@ -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
@@ -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