fgf.lisp

;;;; cl-overload.lisp

(in-package #:cl-overload)


(defgeneric generic-find (item sequence &key test)
  (:generic-function-class fast-generic-functions:fast-generic-function))

(defmethod generic-find (item (list list) &key (test #'eql))
  (and (member item list :test test)
     t))

(defmethod generic-find (item (vector vector) &key (test #'eql))
  (find item vector :test test))

;(seal-domain #'generic-find '(t list))
;(seal-domain #'generic-find '(t vector))

#||
Generic Interfaces
Equality EQUALP = /=
Comparison
LESSP LESS-EQUAL-P GREATERP GREATER-EQUAL-P COMPARE <  <= > > MIN MAX Arithmetic ADD SUBTRACT MULTIPLY
DIVIDE NEGATE + - * /  1+ 1- INCF DECF MINUSP PLUSP  ZEROP SIGNUM ABS EVENP ODDP FLOOR CEILING
TRUNCATE ROUND MOD REM Objects COPY
||#


;;------------------------Arithmetics-----------------------------
(defgeneric binary-+ (x y)
  (:generic-function-class fast-generic-functions:fast-generic-function))

(defmethod binary-+ ((x number) (y number))
  (declare (fast-generic-functions:method-properties fast-generic-functions:inlineable))
  (+ x y))
(fast-generic-functions:seal-domain #'binary-+ '(number number))

(defgeneric binary-- (x y)
  (:generic-function-class fast-generic-functions:fast-generic-function))

(defmethod binary-- ((x number) (y number))
  (declare (fast-generic-functions:method-properties fast-generic-functions:inlineable))
  (- x y))
(fast-generic-functions:seal-domain #'binary-- '(number number))

(defgeneric binary-* (x y &key &allow-other-keys)
  (:generic-function-class fast-generic-functions:fast-generic-function))

(defmethod binary-* ((x number) (y number) &key &allow-other-keys)
  (declare (fast-generic-functions:method-properties fast-generic-functions:inlineable))
  (* x y))
(fast-generic-functions:seal-domain #'binary-* '(number number))

(defgeneric binary-/ (x y)
  (:generic-function-class fast-generic-functions:fast-generic-function))

(defmethod binary-/ ((x number) (y number))
  (declare (fast-generic-functions:method-properties fast-generic-functions:inlineable))
  (/ x y))
(fast-generic-functions:seal-domain #'binary-/ '(number number))

(defun generic-+ (&rest things)
  (cond ((null things) 0)
        ((null (rest things)) (first things))
        (t (reduce #'binary-+ things))))

(define-compiler-macro generic-+ (&rest things)
  (cond ((null things) 0)
        ((null (rest things)) (first things))
        (t (reduce (lambda (a b) `(binary-+ ,a ,b)) things))))

(defun generic-* (&rest things)
  (cond ((null things) 1)
        ((null (rest things)) (first things))
        (t (reduce #'binary-* things))))

(define-compiler-macro generic-* (&rest things)
  (cond ((null things) 1)
        ((null (rest things)) (first things))
        (t (reduce (lambda (a b) `(binary-* ,a ,b)) things))))


(defmethod binary-+ ((lstr string) (rstr string))
  (concatenate 'string lstr rstr))

(defmethod binary-* ((vec sequence) (x number) &key sequence)
  (map sequence (lambda (elt) (binary-* elt x)) vec))