;    Copyright (C) 2006  Will M. Farr <farr@mit.edu>
;
;    This program is free software; you can redistribute it and/or modify
;    it under the terms of the GNU General Public License as published by
;    the Free Software Foundation; either version 2 of the License, or
;    (at your option) any later version.
;
;    This program is distributed in the hope that it will be useful,
;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;    GNU General Public License for more details.
;
;    You should have received a copy of the GNU General Public License along
;    with this program; if not, write to the Free Software Foundation, Inc.,
;    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.


(module operators "generics.ss"
  (provide <operator> operator? <linear-operator> linear-operator?)
  
  (defentityclass <operator> ()
    :auto #t
    :printer #t)
  
  (defentityclass <linear-operator> (<operator>)
    :auto #t
    :printer #t)
  
  (defmethod (times (o <operator>)) o)
  (defmethod (mul (o1 <operator>) (o2 <operator>))
    (let ((c1 (class-of o1)))
      (if (not (eq? c1 (class-of o2)))
          (if (next-method?)
              (call-next-method)
              (raise-type-error '* "operators of same type" (list o1 o2)))
          (let ((result (make c1)))
            (set-instance-proc! result (compose o1 o2))
            result))))
  (defmethod (mul (o <operator>) (x <number>))
    (let ((result (make (class-of o))))
      (set-instance-proc! result (lambda args (* x (apply o args))))
      result))
  (defmethod (mul (x <number>) (o <operator>))
    (mul o x))
  
  (defmethod (plus (lo <linear-operator>)) lo)
  (defmethod (add (lo1 <linear-operator>) (lo2 <linear-operator>))
    (let ((c1 (class-of lo1)))
      (if (not (eq? c1 (class-of lo2)))
          (if (next-method?)
              (call-next-method)
              (raise-type-error '+ "linear operators of same type" (list lo1 lo2)))
          (let ((result (make c1)))
            (set-instance-proc! result (lambda args (+ (apply lo1 args)
                                                       (apply lo2 args))))
            result))))
  
  (defmethod (minus (lo <linear-operator>))
    (let ((result (make (class-of lo))))
      (set-instance-proc! result (lambda args (- (apply lo args))))
      result))
  (defmethod (sub (lo1 <linear-operator>) (lo2 <linear-operator>))
    (let ((c1 (class-of lo1)))
      (if (not (eq? c1 (class-of lo2)))
          (if (next-method?)
              (call-next-method)
              (raise-type-error '+ "linear operators of same type" (list lo1 lo2)))
          (let ((result (make c1)))
            (set-instance-proc! result (lambda args (- (apply lo1 args)
                                                       (apply lo2 args))))
            result)))))