;; -*-theme-d-*-

;; Copyright (C) 2014  Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.

;; Expected results: compilation error
;;   declared method not defined


(define-body (tests test247)


  (define-param-proc make-matrix (%number)
		     (((rows <integer>) (columns <integer>) (element %number))
		      (:matrix %number)
		      (pure))
    (assert (>= rows 0))
    (assert (>= columns 0))
    (make (:matrix %number) rows columns
	  (make-mutable-value-vector %number (* rows columns) element)))


  (define-param-proc make-diagonal-matrix (%number)
		     (((len <integer>)
		       (element %number))
		      (:diagonal-matrix %number)
		      (force-pure))
    (assert (>= len 0))
    (make (:diagonal-matrix %number) len
	  (make-mutable-value-vector %number len element)))


  (define-param-method matrix-ref (%number)
		       (((mx (:matrix %number))
			 (i-row <integer>)
			 (i-column <integer>))
			%number
			(pure))
    (let ((rows (field-ref mx 'rows))
	  (columns (field-ref mx 'columns)))
      (assert (and (>= i-row 0) (< i-row rows)))
      (assert (and (>= i-column 0) (< i-column columns)))
      (mutable-value-vector-ref
       (field-ref mx 'contents)
       (+ (* i-row columns) i-column))))


  (define-param-method matrix-ref (%number)
		       (((mx (:diagonal-matrix %number))
			 (i-row <integer>)
			 (i-column <integer>))
			%number
			(pure))
    (let ((len (field-ref mx 'len)))
      (assert (and (>= i-row 0) (< i-row len)))
      (assert (and (>= i-column 0) (< i-column len)))
      (if (= i-row i-column)
	  (mutable-value-vector-ref
	   (field-ref mx 'contents)
	   i-row)
	  (zero %number))))


  (define-param-method matrix-set! (%number)
		       (((mx (:matrix %number))
			 (i-row <integer>)
			 (i-column <integer>)
			 (element %number))
			<none>
			(nonpure))
    (let ((rows (field-ref mx 'rows))
	  (columns (field-ref mx 'columns)))
      (assert (and (>= i-row 0) (< i-row rows)))
      (assert (and (>= i-column 0) (< i-column columns)))
      (mutable-value-vector-set!
       (field-ref mx 'contents)
       (+ (* i-row columns) i-column) element)))


  (define-param-method matrix-set! (%number)
		       (((mx (:diagonal-matrix %number))
			 (i-row <integer>)
			 (i-column <integer>)
			 (element %number))
			<none>
			(nonpure))
    (let ((len (field-ref mx 'len)))
      (assert (and (>= i-row 0) (< i-row len)))
      (assert (= i-row i-column))
      (mutable-value-vector-set! (field-ref mx 'contents)
				 i-row element)))


  (define-param-proc diagonal-matrix-set! (%number)
		     (((mx (:diagonal-matrix %number))
		       (i <integer>)
		       (element %number))
		      <none>
		      (nonpure))
      (assert (and (>= i 0) (< i (field-ref mx 'len))))
      (mutable-value-vector-set!
       (field-ref mx 'contents)
       i element))


  (define-param-proc matrix* (%number)
		     (((mx1 (:matrix %number)) (mx2 (:matrix %number)))
		      (:matrix %number)
		      (force-pure))
    (let ((rows1 (field-ref mx1 'rows))
	  (columns1 (field-ref mx1 'columns))
	  (rows2 (field-ref mx2 'rows))
	  (columns2 (field-ref mx2 'columns)))
      (assert (= columns1 rows2))
      (let ((result (make-matrix rows1 columns2 (zero %number))))
	(do ((i1 <integer> 0 (+ i1 1))) ((>= i1 rows1))
	  (do ((i2 <integer> 0 (+ i2 1))) ((>= i2 columns2))
	    (let-mutable ((sum %number (zero %number)))
	      (do ((i3 <integer> 0 (+ i3 1))) ((>= i3 columns1))
		(set! sum
		      (+ sum
			 (* (matrix-ref mx1 i1 i3)
			    (matrix-ref mx2 i3 i2)))))
	      (matrix-set! result i1 i2 sum))))
	result)))


  (define-param-proc diagonal-matrix* (%number)
		     (((mx1 (:diagonal-matrix %number))
		       (mx2 (:diagonal-matrix %number)))
		      (:diagonal-matrix %number)
		      (force-pure))
    (let ((len1 (field-ref mx1 'len))
	  (len2 (field-ref mx2 'len)))
      (assert (= len1 len2))
      (let* ((result (make-diagonal-matrix len1 (zero %number)))
	     (vec1 (field-ref mx1 'contents))
	     (vec2 (field-ref mx2 'contents))
	     (vec-r (field-ref result 'contents)))
	(do ((i <integer> 0 (+ i 1))) ((>= i len1))
	  (mutable-value-vector-set! vec-r
				     (* (mutable-value-vector-ref vec1 i)
					(mutable-value-vector-ref vec2 i))))
	result)))


  ;; (add-method * matrix*)


  (add-method * diagonal-matrix*)


  (define-param-method * (%number)
		       (((nr %number) (mx (:matrix %number)))
			(:matrix %number)
			(force-pure))
    (let* ((rows (field-ref mx 'rows))
	   (columns (field-ref mx 'columns))
	   (result (make-matrix rows columns (zero %number)))
	   (vec-r (field-ref result 'contents))
	   (vec-s (field-ref mx 'contents))
	   (raw-len (mutable-value-vector-length vec-s)))
      (assert (= (mutable-value-vector-length vec-r) raw-len))
      (do ((i <integer> 0 (+ i 1))) ((>= i raw-len))
	(mutable-value-vector-set!
	 vec-r i
	 (* nr (mutable-value-vector-ref vec-s i))))
      result))


  (define-param-method * (%number)
		       (((mx (:matrix %number)) (nr %number))
			(:matrix %number)
			(force-pure))
    (let* ((rows (field-ref mx 'rows))
	   (columns (field-ref mx 'columns))
	   (result (make-matrix rows columns (zero %number)))
	   (vec-r (field-ref result 'contents))
	   (vec-s (field-ref mx 'contents))
	   (raw-len (mutable-value-vector-length vec-s)))
      (assert (= (mutable-value-vector-length vec-r) raw-len))
      (do ((i <integer> 0 (+ i 1))) ((>= i raw-len))
	(mutable-value-vector-set!
	 vec-r i
	 (* nr (mutable-value-vector-ref vec-s i))))
      result))


  (define-param-method * (%number)
		       (((nr %number) (mx (:diagonal-matrix %number)))
			(:diagonal-matrix %number)
			(force-pure))
    (let* ((len (field-ref mx 'len))
	   (result (make-diagonal-matrix len (zero %number)))
	   (vec-r (field-ref result 'contents))
	   (vec-s (field-ref mx 'contents)))
      (do ((i <integer> 0 (+ i 1))) ((>= i len))
	(mutable-value-vector-set!
	 vec-r i
	 (* nr (mutable-value-vector-ref vec-s i))))
      result))


  (define-param-method * (%number)
		       (((mx (:diagonal-matrix %number)) (nr %number))
			(:diagonal-matrix %number)
			(force-pure))
    (let* ((len (field-ref mx 'len))
	   (result (make-diagonal-matrix len (zero %number)))
	   (vec-r (field-ref result 'contents))
	   (vec-s (field-ref mx 'contents)))
      (do ((i <integer> 0 (+ i 1))) ((>= i len))
	(mutable-value-vector-set!
	 vec-r i
	 (* nr (mutable-value-vector-ref vec-s i))))
      result)))
