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 ;; Basic functions
  19 (defun * (x y) (* x y))
  20 (defun / (x y) (/ x y))
  21 (defun 1+ (x) (+ x 1))
  22 (defun 1- (x) (- x 1))
  23
  24 (defun + (&rest args)
  25   (let ((r 0))
  26     (dolist (x args r)
  27       (incf r x))))
  28
  29 (defun - (x &rest others)
  30   (if (null others)
  31       (- x)
  32       (let ((r x))
  33         (dolist (y others r)
  34           (decf r y)))))
  35
  36 (defun truncate (x &optional (y 1))
  37   (floor (/ x y)))
  38
  39 (defun integerp (x)
  40   (and (numberp x) (= (floor x) x)))
  41
  42 (defun floatp (x)
  43   (and (numberp x) (not (integerp x))))
  44
  45 (defun minusp (x) (< x 0))
  46 (defun zerop (x) (= x 0))
  47 (defun plusp (x) (< 0 x))
  48
  49 ;; TODO: Use MACROLET when it exists
  50 (defmacro defcomparison (operator)
  51   `(defun ,operator (x &rest args)
  52      (dolist (y args)
  53        (if (,operator x y)
  54          (setq x    (car args))
  55          (return-from ,operator nil)))
  56      t))
  57
  58 (defcomparison >)
  59 (defcomparison >=)
  60 (defcomparison =)
  61 (defcomparison <)
  62 (defcomparison <=)
  63
  64 (defconstant pi 3.141592653589793)
  65
  66 (defun evenp (x) (= (mod x 2) 0))
  67 (defun oddp  (x) (not (evenp x)))
  68
  69 (flet ((%max-min (x xs func)
  70          (dolist (y xs)
  71            (setq x  (if (funcall func x (car xs)) x y)))
  72          x))
  73   (defun max (x &rest xs) (%max-min x xs #'>))
  74   (defun min (x &rest xs) (%max-min x xs #'<)))
  75
  76 (defun abs (x) (if (> x 0) x (- x)))
  77
  78 (defun expt (base power) (expt base              power))
  79 (defun exp  (power)      (expt 2.718281828459045 power))