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 ;; TODO: Use MACROLET when it exists
  19 (defmacro define-variadic-op (operator initial-value)
  20   (let ((init-sym   (gensym))
  21         (dolist-sym (gensym)))
  22     `(defun ,operator (&rest args)
  23        (let ((,init-sym ,initial-value))
  24          (dolist (,dolist-sym args)
  25            (setq ,init-sym (,operator ,init-sym ,dolist-sym)))
  26          ,init-sym))))
  27
  28 (define-variadic-op + 0)
  29 (define-variadic-op * 1)
  30
  31 ;; - and / work differently from the above macro.
  32 ;; If only one arg is given, it negates it or takes its reciprocal.
  33 ;; Otherwise all the other args are subtracted from or divided by it.
  34 ;; TODO: Use MACROLET when it exists
  35 (defmacro define-sub-or-div (operator unary-form)
  36   `(defun ,operator (x &rest args)
  37      (cond
  38        ((null args) ,unary-form)
  39        (t (dolist (y args)
  40             (setq x (,operator x y)))
  41           x))))
  42
  43 (define-sub-or-div - (-   x))
  44 (define-sub-or-div / (/ 1 x))
  45
  46 (defun 1+ (x) (+ x 1))
  47 (defun 1- (x) (- x 1))
  48
  49 (defun truncate (x &optional (y 1))
  50   (floor (/ x y)))
  51
  52 (defun integerp (x)
  53   (and (numberp x) (= (floor x) x)))
  54
  55 (defun floatp (x)
  56   (and (numberp x) (not (integerp x))))
  57
  58 (defun minusp (x) (< x 0))
  59 (defun zerop (x) (= x 0))
  60 (defun plusp (x) (< 0 x))
  61
  62 ;; TODO: Use MACROLET when it exists
  63 (defmacro defcomparison (operator)
  64   `(defun ,operator (x &rest args)
  65      (dolist (y args)
  66        (if (,operator x y)
  67          (setq x    (car args))
  68          (return-from ,operator nil)))
  69      t))
  70
  71 (defcomparison >)
  72 (defcomparison >=)
  73 (defcomparison =)
  74 (defcomparison <)
  75 (defcomparison <=)
  76 (defcomparison /=)
  77
  78 (defconstant pi 3.141592653589793)
  79
  80 (defun evenp (x) (= (mod x 2) 0))
  81 (defun oddp  (x) (not (evenp x)))
  82
  83 (flet ((%max-min (x xs func)
  84          (dolist (y xs)
  85            (setq x  (if (funcall func x (car xs)) x y)))
  86          x))
  87   (defun max (x &rest xs) (%max-min x xs #'>))
  88   (defun min (x &rest xs) (%max-min x xs #'<)))
  89
  90 (defun abs (x) (if (> x 0) x (- x)))
  91
  92 (defun expt (base power) (expt base              power))
  93 (defun exp  (power)      (expt 2.718281828459045 power))