From: Raymond T. <rt...@us...> - 2013-08-15 03:55:25
|
This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "Maxima CAS". The branch, master has been updated via b592a370a08380e081b7800d630ef4377bbc2f4d (commit) from b9ab71f360b9a3e1e575a86bfca81fd4dacb4b50 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit b592a370a08380e081b7800d630ef4377bbc2f4d Author: Raymond Toy <toy...@gm...> Date: Wed Aug 14 20:55:10 2013 -0700 Make incorrect number of args to elliptic functions generate a maxima error instead of a lisp error. src/numerical/slatec/quadpack.lisp: o Move DEFUN-CHECKED to src/clmacs.lisp src/clmacs.lisp: o Update DEFUN-CHECKED to be more generally usable. src/ellipt.lisp: o Use DEFUN-CHECKED to define the forward and inverse elliptic functions. diff --git a/src/clmacs.lisp b/src/clmacs.lisp index b7d827e..7cec720 100644 --- a/src/clmacs.lisp +++ b/src/clmacs.lisp @@ -572,3 +572,51 @@ ; one2 k ; one1 l ; nil + +;; Defines a function named NAME that checks that the number of +;; arguments is correct. If the number of actual arguments is +;; incorrect, a maxima error is signaled. +;; +;; The required arguments is given by REQUIRED-ARG-LIST. Allowed +;; (maxima) keyword arguments is given by KEYWORD-ARG-LIST. +;; +;; The body of the function can refer to KEYLIST which is the list of +;; maxima keyword arguments converted to lisp keyword arguments. + +(defmacro defun-checked (name ((&rest required-arg-list) + &rest keyword-arg-list) + &body body) + (let ((number-of-required-args (length required-arg-list)) + (number-of-keyword-args (length keyword-arg-list)) + (arg-list (gensym "ARG-LIST-")) + (helper-fun (gensym "REAL-FUN-")) + (options (gensym "OPTIONS-ARG-"))) + `(defun ,name (&rest ,arg-list) + ;; Check that the required number of arguments is given and + ;; that we don't supply too many arguments. + ;; + ;; NOTE: The check when keyword args are given is a little too + ;; tight. It's valid to have duplicate keyword args, but we + ;; disallow that if the number of arguments exceed the limit. + (when (or (> (length ,arg-list) ,(+ number-of-required-args number-of-keyword-args)) + (< (length ,arg-list) ,number-of-required-args)) + (merror (intl:gettext "~M arguments supplied to ~M: found ~M") + (if (< (length ,arg-list) ,number-of-required-args) + (intl:gettext "Too few") + (if (> (length ,arg-list) ,(+ number-of-required-args + number-of-keyword-args)) + (intl:gettext "Too many") + (intl:gettext "Incorrect number of"))) + ',(if keyword-arg-list + `((,name) ,@required-arg-list ((mlist simp) ,@keyword-arg-list)) + `((,name) ,@required-arg-list)) + (cons '(mlist) ,arg-list))) + (flet ((,helper-fun (,@required-arg-list + ,@(when keyword-arg-list + `(&rest ,options))) + (let ,(when keyword-arg-list + `((keylist (lispify-maxima-keyword-options ,options + ',keyword-arg-list)))) + ,@body))) + (apply #',helper-fun ,arg-list))))) + diff --git a/src/ellipt.lisp b/src/ellipt.lisp index d765868..96be336 100644 --- a/src/ellipt.lisp +++ b/src/ellipt.lisp @@ -556,20 +556,20 @@ ;; Define the actual functions for the user -(defmfun $jacobi_sn (u m) +(defun-checked $jacobi_sn ((u m)) (simplify (list '(%jacobi_sn) (resimplify u) (resimplify m)))) -(defmfun $jacobi_cn (u m) +(defun-checked $jacobi_cn ((u m)) (simplify (list '(%jacobi_cn) (resimplify u) (resimplify m)))) -(defmfun $jacobi_dn (u m) +(defun-checked $jacobi_dn ((u m)) (simplify (list '(%jacobi_dn) (resimplify u) (resimplify m)))) -(defmfun $inverse_jacobi_sn (u m) +(defun-checked $inverse_jacobi_sn ((u m)) (simplify (list '(%inverse_jacobi_sn) (resimplify u) (resimplify m)))) -(defmfun $inverse_jacobi_cn (u m) +(defun-checked $inverse_jacobi_cn ((u m)) (simplify (list '(%inverse_jacobi_cn) (resimplify u) (resimplify m)))) -(defmfun $inverse_jacobi_dn (u m) +(defun-checked $inverse_jacobi_dn ((u m)) (simplify (list '(%inverse_jacobi_dn) (resimplify u) (resimplify m)))) ;; Possible forms of a complex number: diff --git a/src/numerical/slatec/quadpack.lisp b/src/numerical/slatec/quadpack.lisp index 83d751c..25472ae 100644 --- a/src/numerical/slatec/quadpack.lisp +++ b/src/numerical/slatec/quadpack.lisp @@ -338,51 +338,9 @@ (quad-control parameter (if new-value (car new-value)))) -;; Defines a function named NAME that checks that the number of -;; arguments is correct. If the number of actual arguments is -;; incorrect, a maxima error is signaled. -;; -;; The required arguments is given by REQUIRED-ARG-LIST. Allowed -;; (maxima) keyword arguments is given by KEYWORD-ARG-LIST. -;; -;; The body of the function can refer to KEYLIST which is the list of -;; maxima keyword arguments converted to lisp keyword arguments. - -(defmacro defun-checked (name ((&rest required-arg-list) - (&rest keyword-arg-list)) - &body body) - (let ((number-of-required-args (length required-arg-list)) - (number-of-keyword-args (length keyword-arg-list)) - (arg-list (gensym "ARG-LIST-")) - (helper-fun (gensym "REAL-FUN-")) - (options (gensym "OPTIONS-ARG-"))) - `(defun ,name (&rest ,arg-list) - ;; Check that the required number of arguments is given and - ;; that we don't supply too many arguments. - ;; - ;; NOTE: The check when keyword args are given is a little too - ;; tight. It's valid to have duplicate keyword args, but we - ;; disallow that if the number of arguments exceed the limit. - (when (or (> (length ,arg-list) ,(+ number-of-required-args number-of-keyword-args)) - (< (length ,arg-list) ,number-of-required-args)) - (merror (intl:gettext "~M arguments supplied to ~M: found ~M") - (if (< (length ,arg-list) ,number-of-required-args) - (intl:gettext "Too few") - (if (> (length ,arg-list) ,(+ number-of-required-args - number-of-keyword-args)) - (intl:gettext "Too many") - (intl:gettext "Incorrect number of"))) - `((,',name) ,@',required-arg-list ((mlist simp) ,@',keyword-arg-list)) - (cons '(mlist) ,arg-list))) - (flet ((,helper-fun (,@required-arg-list &rest ,options) - (let ((keylist (lispify-maxima-keyword-options ,options - ',keyword-arg-list))) - ,@body))) - (apply #',helper-fun ,arg-list))))) - (macrolet ((frob (mname iname args valid-keys) - `(defun-checked ,mname ((,@args) (,@valid-keys)) + `(defun-checked ,mname ((,@args) ,@valid-keys) ;; BIND EVIL SPECIAL VARIABLE *PLOT-REALPART* HERE ... (let ((*plot-realpart* nil)) (declare (special *plot-realpart*)) ----------------------------------------------------------------------- Summary of changes: src/clmacs.lisp | 48 ++++++++++++++++++++++++++++++++++++ src/ellipt.lisp | 12 ++++---- src/numerical/slatec/quadpack.lisp | 44 +-------------------------------- 3 files changed, 55 insertions(+), 49 deletions(-) hooks/post-receive -- Maxima CAS |