;; -*-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: translation and running OK


(define-proper-program (tests test709)

  (import (standard-library core)
	  (standard-library list-utilities)
	  (standard-library matrix)
	  (tests numerical-test-env))

  (define-param-proc my-matrix (%number)
		     (((elements (:uniform-list (:uniform-list %number))))
		      (:matrix %number)
		      force-pure)
    (let ((rows (length elements)))
      (assert (> rows 0))
      (let ((columns (length (gen-car elements))))
	(assert (and-map?
		 (lambda (((row (:uniform-list %number))) <boolean> (pure))
		   (= (length row) columns))
		 (gen-cdr elements)))
	(let ((result (make-matrix rows columns (zero %number))))
	  (do ((i-row <integer> 0 (+ i-row 1))
	       (cur-elements (:uniform-list (:uniform-list %number))
			     elements (gen-cdr cur-elements)))
	      ((>= i-row rows))
	    (do ((i-column <integer> 0 (+ i-column 1))
		 (cur-elements2 (:uniform-list %number)
		  (gen-car cur-elements) (gen-cdr cur-elements2)))
		((>= i-column columns))
	      (matrix-set! result i-row i-column (gen-car cur-elements2))))
	  result))))

  (define-param-proc my-diagonal-matrix (%number)
		     (((elements (:uniform-list %number)))
		      (:diagonal-matrix %number)
		      force-pure)
    (let* ((i-len (length elements))
	   (mx (make-diagonal-matrix i-len (zero %number))))
      (do ((i <integer> 0 (+ i 1))
	   (l-cur (:uniform-list %number) elements (gen-cdr l-cur)))
	  ((>= i i-len))
	(diagonal-matrix-set! mx i (gen-car l-cur)))
      mx))
      	   
  (define-simple-proc main (() <none> nonpure)
    (let ((mx1 (my-matrix (list
			   (list 1.0 0.0 2.0 0.0)
			   (list -1.5 2.5 0.0 5.0)
			   (list -3.0 -2.0 1.0 1.0))))
	  (mx2 (my-matrix (list
			   (list 1.0 0.0 2.0 0.0)
			   (list -1.5 2.5 0.0 5.0)
			   (list -3.0 -2.0 1.0 1.0))))
	  (mx3 (my-matrix (list
			   (list 1.0 0.0 2.0 0.0)
			   (list -1.5 2.5 0.0 5.0)
			   (list -3.0 -2.0 -1.0 1.0))))
	  (mx4 (my-matrix (list
			   (list 5.0 0.0 0.0)
			   (list 0.0 2.0 0.0)
			   (list 0.0 0.0 -1.0))))
	  (mx5 (my-diagonal-matrix (list 5.0 2.0 -1.0)))
	  (mx6 (my-diagonal-matrix (list 5.0 2.0 -1.0)))
	  (mx7 (my-diagonal-matrix (list -15.0 3.0 -2.1)))
	  (mx8 (my-diagonal-matrix (list -15.0 3.0 -2.1 1.2))))
      (report-boolean-test (= mx1 mx1) #t)
      (report-boolean-test (= mx1 mx2) #t)
      (report-boolean-test (= mx1 mx3) #f)
      (report-boolean-test (= mx1 mx4) #f)
      (report-boolean-test (= mx5 mx5) #t)
      (report-boolean-test (= mx5 mx6) #t)
      (report-boolean-test (= mx5 mx7) #f)
      (report-boolean-test (= mx7 mx8) #f))))
