src/numbers.lisp

   1 ;;; numbers.lisp
   2
   3 ;; JSCL is free software: you can redistribute it and/or
   4 ;; modify it under the terms of the GNU General Public License as
   5 ;; published by the Free Software Foundation, either version 3 of the
   6 ;; License, or (at your option) any later version.
   7 ;;
   8 ;; JSCL is distributed in the hope that it will be useful, but
   9 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 ;; General Public License for more details.
  12 ;;
  13 ;; You should have received a copy of the GNU General Public License
  14 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 ;;;; Various numeric functions and constants
  17
  18 (macrolet ((def (operator initial-value)
  19              (let ((init-sym   (gensym))
  20                    (dolist-sym (gensym)))
  21                `(defun ,operator (&rest args)
  22                   (let ((,init-sym ,initial-value))
  23                     (dolist (,dolist-sym args)
  24                       (setq ,init-sym (,operator ,init-sym ,dolist-sym)))
  25                     ,init-sym)))))
  26   (def + 0)
  27   (def * 1))
  28
  29 ;; - and / work differently from the above macro.
  30 ;; If only one arg is given, it negates it or takes its reciprocal.
  31 ;; Otherwise all the other args are subtracted from or divided by it.
  32 (macrolet ((def (operator unary-form)
  33              `(defun ,operator (x &rest args)
  34                 (cond
  35                   ((null args) ,unary-form)
  36                   (t (dolist (y args)
  37                        (setq x (,operator x y)))
  38                      x)))))
  39   (def - (-   x))
  40   (def / (/ 1 x)))
  41
  42
  43 (defun 1+ (x) (+ x 1))
  44 (defun 1- (x) (- x 1))
  45
  46 (defun truncate (x &optional (y 1))
  47   (floor (/ x y)))
  48
  49 (defun integerp (x)
  50   (and (numberp x) (= (floor x) x)))
  51
  52 (defun floatp (x)
  53   (and (numberp x) (not (integerp x))))
  54
  55 (defun minusp (x) (< x 0))
  56 (defun zerop (x) (= x 0))
  57 (defun plusp (x) (< 0 x))
  58
  59 (macrolet ((def (operator)
  60              `(defun ,operator (x &rest args)
  61                 (dolist (y args)
  62                   (if (,operator x y)
  63                       (setq x    (car args))
  64                       (return-from ,operator nil)))
  65                 t)))
  66   (def >)
  67   (def >=)
  68   (def =)
  69   (def <)
  70   (def <=)
  71   (def /=))
  72
  73 (defconstant pi 3.141592653589793)
  74
  75 (defun evenp (x) (= (mod x 2) 0))
  76 (defun oddp  (x) (not (evenp x)))
  77
  78 (flet ((%max-min (x xs func)
  79          (dolist (y xs)
  80            (setq x  (if (funcall func x (car xs)) x y)))
  81          x))
  82   (defun max (x &rest xs) (%max-min x xs #'>))
  83   (defun min (x &rest xs) (%max-min x xs #'<)))
  84
  85 (defun abs (x) (if (> x 0) x (- x)))
  86
  87 (defun expt (base power) (expt base              power))
  88 (defun exp  (power)      (expt 2.718281828459045 power))