1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
;; -*-theme-d-*-
;; Copyright (C) 2023 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.
(define-body (tests matrix-test-env)
(import (standard-library console-io)
(standard-library list-utilities))
(define-syntax generate-print-method
(syntax-rules ()
((_ &type)
(define-simple-method console-display-matrix
(((mx &type)) <none> nonpure)
(let ((i-rows (number-of-rows mx))
(i-columns (number-of-columns mx)))
(do ((i1 <integer> 0 (+ i1 1))) ((>= i1 i-rows))
(do ((i2 <integer> 0 (+ i2 1))) ((>= i2 i-columns))
(console-display (matrix-ref mx i1 i2))
(if (< i2 i-columns)
(console-display " ")))
(console-newline)))))))
(define-syntax generate-print-method1
(syntax-rules ()
((_ &type)
(define-simple-method console-display-matrix
(((mx &type)) <none> nonpure)
(let ((i-rows (number-of-rows mx))
(i-columns (number-of-columns mx)))
(do ((i1 <integer> 0 (+ i1 1))) ((>= i1 i-rows))
(do ((i2 <integer> 0 (+ i2 1))) ((>= i2 i-columns))
(console-display (bvm-ref mx i1 i2))
(if (< i2 i-columns)
(console-display " ")))
(console-newline)))))))
(define-syntax generate-diag-printable-method
(syntax-rules ()
((_ &type)
(define-simple-method diag-printable-repr
(((mx &type)) <list> pure)
(let ((i-elements (diag-matrix-numel mx)))
(let-mutable ((l-result <list> null))
(do ((i <integer> 0 (+ i 1))) ((>= i i-elements))
(set! l-result
(append-uniform2 l-result
(list (diagonal-matrix-ref mx i)))))
l-result))))))
(define-syntax generate-report-method
(syntax-rules ()
((_ &type)
(define-simple-method do-report-matrix-test
(((x-expr <object>) (mx-result &type) (mx-correct &type))
<none> nonpure)
(console-write x-expr)
(console-display-line " =")
(console-display-matrix mx-result)
(if (= mx-result mx-correct)
(console-display "OK")
(console-display "FAIL"))
(console-newline)))))
(define-syntax generate-report-diag-method
(syntax-rules ()
((_ &type)
(define-simple-method do-report-diag-matrix-test
(((x-expr <object>) (mx-result &type) (mx-correct &type))
<none> nonpure)
(console-write x-expr)
(console-display-line " =")
(console-display (cons 'diag (diag-printable-repr mx-result)))
(console-display " ")
(if (= mx-result mx-correct)
(console-display "OK")
(console-display "FAIL"))
(console-newline)))))
(generate-print-method (:matrix <real>))
(generate-print-method (:matrix <complex>))
(generate-diag-printable-method (:diagonal-matrix <real>))
(generate-diag-printable-method (:diagonal-matrix <complex>))
(generate-print-method1 <bvm-matrix>)
(generate-print-method1 <bvm-complex-matrix>)
(generate-print-method1 <bvm-single-matrix>)
(generate-print-method1 <bvm-single-complex-matrix>)
(generate-diag-printable-method <bvm-diag-matrix>)
(generate-diag-printable-method <bvm-complex-diag-matrix>)
(generate-diag-printable-method <bvm-single-diag-matrix>)
(generate-diag-printable-method <bvm-single-complex-diag-matrix>)
(generate-report-method (:matrix <real>))
(generate-report-method (:matrix <complex>))
(generate-report-diag-method (:diagonal-matrix <real>))
(generate-report-diag-method (:diagonal-matrix <complex>))
(generate-report-method <bvm-matrix>)
(generate-report-method <bvm-complex-matrix>)
(generate-report-method <bvm-single-matrix>)
(generate-report-method <bvm-single-complex-matrix>)
(generate-report-diag-method <bvm-diag-matrix>)
(generate-report-diag-method <bvm-complex-diag-matrix>)
(generate-report-diag-method <bvm-single-diag-matrix>)
(generate-report-diag-method <bvm-single-complex-diag-matrix>))
|
