1
(* Orpie -- a stack-based RPN calculator for the console
2
* Copyright (C) 2003-2004 Paul Pelzl
4
* This program is free software; you can redistribute it and/or modify
5
* it under the terms of the GNU General Public License as published by
6
* the Free Software Foundation; either version 2 of the License, or
7
* (at your option) any later version.
9
* This program is distributed in the hope that it will be useful,
10
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12
* GNU General Public License for more details.
14
* You should have received a copy of the GNU General Public License
15
* along with this program; if not, write to the Free Software
16
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18
* Please send bug reports, patches, etc. to Paul Pelzl at
19
* <pelzlpj@eecs.umich.edu>.
26
let mult (stack : rpc_stack) (evaln : int -> unit) =
28
let gen_el2 = stack#pop () in
29
let gen_el1 = stack#pop () in
34
stack#push (RpcInt (mult_big_int el1 el2))
36
let fu_el1 = funit_of_float (float_of_big_int el1) in
37
stack#push (RpcFloatUnit (Units.mult fu_el1 el2))
38
|RpcComplexUnit el2 ->
39
let cu_el1 = cunit_of_cpx (cmpx_of_int el1) in
40
stack#push (RpcComplexUnit (Units.mult cu_el1 el2))
41
|RpcFloatMatrixUnit (el2, uu) ->
42
let result = Gsl_matrix.copy el2 in
43
Gsl_matrix.scale result (float_of_big_int el1);
44
stack#push (RpcFloatMatrixUnit (result, uu))
45
|RpcComplexMatrixUnit (el2, uu) ->
46
let c_el1 = cmpx_of_int el1 in
47
let result = Gsl_matrix_complex.copy el2 in
48
Gsl_matrix_complex.scale result c_el1;
49
stack#push (RpcComplexMatrixUnit (result, uu))
53
raise (Invalid_argument "incompatible types for multiplication"))
55
|RpcFloatUnit el1 -> (
58
let fu_el2 = funit_of_float (float_of_big_int el2) in
59
stack#push (RpcFloatUnit (Units.mult el1 fu_el2))
61
stack#push (RpcFloatUnit (Units.mult el1 el2))
62
|RpcComplexUnit el2 ->
63
stack#push (RpcComplexUnit (Units.mult el1 el2))
64
|RpcFloatMatrixUnit (el2, uu) ->
65
let uprod = Units.mult el1 uu in
66
let result = Gsl_matrix.copy el2 in
67
Gsl_matrix.scale result uprod.Units.coeff.Complex.re;
68
stack#push (RpcFloatMatrixUnit (result, unorm uprod))
69
|RpcComplexMatrixUnit (el2, uu) ->
70
let uprod = Units.mult el1 uu in
71
let c_el1 = cmpx_of_float el1.Units.coeff.Complex.re in
72
let result = Gsl_matrix_complex.copy el2 in
73
Gsl_matrix_complex.scale result uprod.Units.coeff;
74
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
78
raise (Invalid_argument "incompatible types for multiplication"))
80
|RpcComplexUnit el1 -> (
83
let cu_el2 = cunit_of_cpx (cmpx_of_int el2) in
84
stack#push (RpcComplexUnit (Units.mult el1 cu_el2))
85
|RpcFloatUnit el2 | RpcComplexUnit el2 ->
86
stack#push (RpcComplexUnit (Units.mult el1 el2))
87
|RpcFloatMatrixUnit (el2, u2) ->
88
let uprod = Units.mult el1 u2 in
89
let c_el2 = cmat_of_fmat el2 in
90
Gsl_matrix_complex.scale c_el2 uprod.Units.coeff;
91
stack#push (RpcComplexMatrixUnit (c_el2, unorm uprod))
92
|RpcComplexMatrixUnit (el2, u2) ->
93
let uprod = Units.mult el1 u2 in
94
let result = Gsl_matrix_complex.copy el2 in
95
Gsl_matrix_complex.scale result uprod.Units.coeff;
96
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
100
raise (Invalid_argument "incompatible types for multiplication"))
102
|RpcFloatMatrixUnit (el1, u1) -> (
105
let result = Gsl_matrix.copy el1 in
106
Gsl_matrix.scale result (float_of_big_int el2);
107
stack#push (RpcFloatMatrixUnit (result, u1))
109
let uprod = Units.mult u1 el2 in
110
let result = Gsl_matrix.copy el1 in
111
Gsl_matrix.scale result uprod.Units.coeff.Complex.re;
112
stack#push (RpcFloatMatrixUnit (result, unorm uprod))
113
|RpcComplexUnit el2 ->
114
let uprod = Units.mult u1 el2 in
115
let c_el1 = cmat_of_fmat el1 in
116
Gsl_matrix_complex.scale c_el1 uprod.Units.coeff;
117
stack#push (RpcComplexMatrixUnit (c_el1, unorm uprod))
118
|RpcFloatMatrixUnit (el2, u2) ->
119
let n1, m1 = (Gsl_matrix.dims el1)
120
and n2, m2 = (Gsl_matrix.dims el2) in
122
let uprod = Units.mult u1 u2 in
123
let result = Gsl_matrix.create n1 m2 in
124
Gsl_blas.gemm Gsl_blas.NoTrans Gsl_blas.NoTrans
125
uprod.Units.coeff.Complex.re el1 el2 0.0 result;
126
stack#push (RpcFloatMatrixUnit (result, unorm uprod))
130
raise (Invalid_argument "incompatible matrix dimensions for multiplication"))
131
|RpcComplexMatrixUnit (el2, u2) ->
132
let n1, m1 = (Gsl_matrix.dims el1)
133
and n2, m2 = (Gsl_matrix_complex.dims el2) in
135
let uprod = Units.mult u1 u2 in
136
let c_el1 = cmat_of_fmat el1
137
and result = Gsl_matrix_complex.create n1 m2 in
138
Gsl_blas.Complex.gemm Gsl_blas.NoTrans Gsl_blas.NoTrans
139
uprod.Units.coeff c_el1 el2 Complex.zero result;
140
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
144
raise (Invalid_argument "incompatible matrix dimensions for multiplication"))
148
raise (Invalid_argument "incompatible types for multiplication"))
150
|RpcComplexMatrixUnit (el1, u1) -> (
153
let c_el2 = cmpx_of_int el2 in
154
let result = Gsl_matrix_complex.copy el1 in
155
Gsl_matrix_complex.scale result c_el2;
156
stack#push (RpcComplexMatrixUnit (result, u1))
158
let uprod = Units.mult u1 el2 in
159
let result = Gsl_matrix_complex.copy el1 in
160
Gsl_matrix_complex.scale result uprod.Units.coeff;
161
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
162
|RpcComplexUnit el2 ->
163
let uprod = Units.mult u1 el2 in
164
let result = Gsl_matrix_complex.copy el1 in
165
Gsl_matrix_complex.scale result uprod.Units.coeff;
166
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
167
|RpcFloatMatrixUnit (el2, u2) ->
168
let n1, m1 = (Gsl_matrix_complex.dims el1)
169
and n2, m2 = (Gsl_matrix.dims el2) in
171
let uprod = Units.mult u1 u2 in
172
let c_el2 = cmat_of_fmat el2
173
and result = Gsl_matrix_complex.create n1 m2 in
174
Gsl_blas.Complex.gemm Gsl_blas.NoTrans Gsl_blas.NoTrans
175
uprod.Units.coeff el1 c_el2 Complex.zero result;
176
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
180
raise (Invalid_argument "incompatible matrix dimensions for multiplication"))
181
|RpcComplexMatrixUnit (el2, u2) ->
182
let n1, m1 = (Gsl_matrix_complex.dims el1)
183
and n2, m2 = (Gsl_matrix_complex.dims el2) in
185
let uprod = Units.mult u1 u2 in
186
let result = Gsl_matrix_complex.create n1 m2 in
187
Gsl_blas.Complex.gemm Gsl_blas.NoTrans Gsl_blas.NoTrans
188
uprod.Units.coeff el1 el2 Complex.zero result;
189
stack#push (RpcComplexMatrixUnit (result, unorm uprod))
193
raise (Invalid_argument "incompatible matrix dimensions for multiplication"))
197
raise (Invalid_argument "incompatible types for multiplication"))
202
raise (Invalid_argument "incompatible types for multiplication"))
205
(* arch-tag: DO_NOT_CHANGE_5fc03e41-d1d3-40da-8b68-9a85d96148d0 *)