-;; TODO: Use MACROLET when it exists
-(defmacro defcomparison (operator)
- `(defun ,operator (x &rest args)
- (while (not (null args))
- (if (,operator x (car args))
- (setq x (car args)
- args (cdr args))
- (return-from ,operator nil)))
- t))
-
-(defcomparison >)
-(defcomparison >=)
-(defcomparison <)
-(defcomparison <=)
+(macrolet ((def (operator initial-value)
+ (let ((init-sym (gensym))
+ (dolist-sym (gensym)))
+ `(defun ,operator (&rest args)
+ (let ((,init-sym ,initial-value))
+ (dolist (,dolist-sym args)
+ (setq ,init-sym (,operator ,init-sym ,dolist-sym)))
+ ,init-sym)))))
+ (def + 0)
+ (def * 1))
+
+;; - and / work differently from the above macro.
+;; If only one arg is given, it negates it or takes its reciprocal.
+;; Otherwise all the other args are subtracted from or divided by it.
+(macrolet ((def (operator unary-form)
+ `(defun ,operator (x &rest args)
+ (cond
+ ((null args) ,unary-form)
+ (t (dolist (y args)
+ (setq x (,operator x y)))
+ x)))))
+ (def - (- x))
+ (def / (/ 1 x)))
+
+
+(defun 1+ (x) (+ x 1))
+(defun 1- (x) (- x 1))
+
+(defun truncate (x &optional (y 1))
+ (floor (/ x y)))
+
+(defun integerp (x)
+ (and (numberp x) (= (floor x) x)))
+
+(defun floatp (x)
+ (and (numberp x) (not (integerp x))))
+
+(defun minusp (x) (< x 0))
+(defun zerop (x) (= x 0))
+(defun plusp (x) (< 0 x))
+
+(defun signum (x)
+ (if (zerop x) x (/ x (abs x))))
+
+(macrolet ((def (operator)
+ `(defun ,operator (x &rest args)
+ (dolist (y args)
+ (if (,operator x y)
+ (setq x (car args))
+ (return-from ,operator nil)))
+ t)))
+ (def >)
+ (def >=)
+ (def =)
+ (def <)
+ (def <=)
+ (def /=))