;;; Lisplab, level1-container.lisp
;;; Container matrices that contains one matrix and passes all operations to this. 
;;; This should be the default matrix. 

;;; Copyright (C) 2010 Joern Inge Vestgaarden
;;;
;;; 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.

;;; TODO: this will only get useful if also implemented on level 2, including 
;;;       high level optimizations. This is a lot of work... 

(in-package :lisplab)

(defclass matrix (matrix-base) 
  ((matrix-content :initarg :content
		   :initform nil
		   :accessor matrix-content
		   :type matrix-base))
  (:documentation "A meta-matrix that contains wraps another matrix.")) 

(defmethod make-matrix-class ((a (eql :any)) (b (eql :any)) (c (eql :any)))
  (find-class 'matrix))

(defmethod initialize-instance :after ((m matrix) &key dim (value 0))
  (with-slots (matrix-content) m
    (unless matrix-content 
      (setf matrix-content 
	    (make-matrix-instance (typecase value 
				    (real 'matrix-dge)
				    (complex 'matrix-zge)
				    (t 'matrix-ge))
				  dim 
				value)))))
			  

;;; Level methods specialized for untyped, general matrices

(defmethod element-type ((m matrix))
  (element-type (slot-value m 'matrix-content)))

(defmethod size ((m matrix))
  (size (slot-value m 'matrix-content)))

(defmethod rows ((m matrix))
  (rows (slot-value m 'matrix-content)))

(defmethod cols ((m matrix))
  (cols (slot-value m 'matrix-content)))

(defmethod dim  ((m matrix) &optional direction)
  (dim (slot-value m 'matrix-content) direction))

(defmethod mref ((matrix matrix) row col)
  (mref (slot-value matrix 'matrix-content) row col))

(defmethod (setf mref) (value (matrix  matrix) row col)
  (with-slots (matrix-content) matrix
    (unless (subtypep (type-of value) (element-type matrix-content))
      (setf matrix-content (convert matrix 'matrix-ge))) ;; could do something more clever here
    (setf (mref matrix-content row col) value)))

(defmethod vref ((matrix matrix) idx)
  (vref (slot-value matrix 'matrix-content) idx))

(defmethod (setf vref) (value (matrix  matrix) idx)
  (with-slots (matrix-content) matrix
    (unless (subtypep (type-of value) (element-type matrix-content))
      (setf matrix-content (convert matrix 'matrix-ge))) ;; could do something more clever here
    (setf (vref matrix-content idx) value)))