|
529
|
1 // tc-rep.cc -*- C++ -*- |
|
492
|
2 /* |
|
|
3 |
|
|
4 Copyright (C) 1992, 1993, 1994 John W. Eaton |
|
|
5 |
|
|
6 This file is part of Octave. |
|
|
7 |
|
|
8 Octave is free software; you can redistribute it and/or modify it |
|
|
9 under the terms of the GNU General Public License as published by the |
|
|
10 Free Software Foundation; either version 2, or (at your option) any |
|
|
11 later version. |
|
|
12 |
|
|
13 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
|
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
|
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
|
16 for more details. |
|
|
17 |
|
|
18 You should have received a copy of the GNU General Public License |
|
|
19 along with Octave; see the file COPYING. If not, write to the Free |
|
|
20 Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
21 |
|
|
22 */ |
|
|
23 |
|
|
24 #ifdef HAVE_CONFIG_H |
|
|
25 #include "config.h" |
|
|
26 #endif |
|
|
27 |
|
|
28 #if defined (__GNUG__) |
|
|
29 #pragma implementation |
|
|
30 #endif |
|
|
31 |
|
|
32 #include <ctype.h> |
|
|
33 #include <string.h> |
|
|
34 #include <fstream.h> |
|
|
35 #include <iostream.h> |
|
|
36 #include <strstream.h> |
|
|
37 |
|
|
38 #include "mx-base.h" |
|
|
39 #include "Range.h" |
|
|
40 |
|
504
|
41 #include "arith-ops.h" |
|
492
|
42 #include "variables.h" |
|
631
|
43 #include "sysdep.h" |
|
492
|
44 #include "error.h" |
|
|
45 #include "gripes.h" |
|
|
46 #include "user-prefs.h" |
|
|
47 #include "utils.h" |
|
|
48 #include "pager.h" |
|
|
49 #include "pr-output.h" |
|
|
50 #include "tree-const.h" |
|
|
51 #include "idx-vector.h" |
|
|
52 |
|
|
53 #include "tc-inlines.cc" |
|
|
54 |
|
581
|
55 // How about a few macros? |
|
492
|
56 |
|
631
|
57 #define TC_REP tree_constant::tree_constant_rep |
|
|
58 |
|
492
|
59 #ifndef MAX |
|
|
60 #define MAX(a,b) ((a) > (b) ? (a) : (b)) |
|
|
61 #endif |
|
|
62 |
|
|
63 #ifndef MIN |
|
|
64 #define MIN(a,b) ((a) < (b) ? (a) : (b)) |
|
|
65 #endif |
|
|
66 |
|
|
67 #ifndef ABS |
|
|
68 #define ABS(x) (((x) < 0) ? (-x) : (x)) |
|
|
69 #endif |
|
|
70 |
|
581
|
71 // The following are used by some of the functions in the |
|
|
72 // tree_constant_rep class that must deal with real and complex |
|
|
73 // matrices. This was not done with overloaded or virtual functions |
|
|
74 // from the Matrix class because there is no clean way to do that -- |
|
|
75 // the necessary functions (like elem) need to return values of |
|
|
76 // different types... |
|
492
|
77 |
|
|
78 // Given a tree_constant, and the names to be used for the real and |
|
|
79 // complex matrix and their dimensions, declare a real or complex |
|
|
80 // matrix, and initialize it from the tree_constant. Note that m, cm, |
|
|
81 // nr, and nc must not be previously declared, and they must not be |
|
|
82 // expressions. Since only one of the matrices will be defined after |
|
|
83 // this macro is used, only one set of dimesions is declared. |
|
|
84 |
|
|
85 // This macro only makes sense inside a friend or member function of |
|
|
86 // the tree_constant_rep class |
|
|
87 |
|
|
88 #define REP_RHS_MATRIX(tc,m,cm,nr,nc) \ |
|
|
89 int nr = 0; \ |
|
|
90 int nc = 0; \ |
|
|
91 Matrix m; \ |
|
|
92 ComplexMatrix cm; \ |
|
631
|
93 if ((tc).const_type () == TC_REP::complex_matrix_constant) \ |
|
492
|
94 { \ |
|
|
95 cm = (tc).complex_matrix_value (); \ |
|
|
96 nr = (cm).rows (); \ |
|
|
97 nc = (cm).columns (); \ |
|
|
98 } \ |
|
631
|
99 else if ((tc).const_type () == TC_REP::matrix_constant) \ |
|
492
|
100 { \ |
|
|
101 m = (tc).matrix_value (); \ |
|
|
102 nr = (m).rows (); \ |
|
|
103 nc = (m).columns (); \ |
|
|
104 } \ |
|
|
105 else \ |
|
|
106 abort (); |
|
|
107 |
|
|
108 // Assign a real or complex value to a tree_constant. |
|
|
109 // |
|
|
110 // This macro only makes sense inside a friend or member function of |
|
|
111 // the tree_constant_rep class. |
|
|
112 |
|
|
113 #define REP_ELEM_ASSIGN(i,j,rval,cval,real_type) \ |
|
|
114 do \ |
|
|
115 { \ |
|
631
|
116 if (type_tag == TC_REP::matrix_constant) \ |
|
492
|
117 { \ |
|
|
118 if (real_type) \ |
|
|
119 matrix->elem ((i), (j)) = (rval); \ |
|
|
120 else \ |
|
|
121 abort (); \ |
|
|
122 } \ |
|
|
123 else \ |
|
|
124 { \ |
|
|
125 if (real_type) \ |
|
|
126 complex_matrix->elem ((i), (j)) = (rval); \ |
|
|
127 else \ |
|
|
128 complex_matrix->elem ((i), (j)) = (cval); \ |
|
|
129 } \ |
|
|
130 } \ |
|
|
131 while (0) |
|
|
132 |
|
|
133 // Given a real and complex matrix and row and column dimensions, |
|
|
134 // declare both and size one of them. Only one of the matrices should |
|
|
135 // be used after this macro has been used. |
|
|
136 |
|
|
137 // This macro only makes sense inside a friend or member function of |
|
|
138 // the tree_constant_rep class. |
|
|
139 |
|
|
140 #define CRMATRIX(m,cm,nr,nc) \ |
|
|
141 Matrix m; \ |
|
|
142 ComplexMatrix cm; \ |
|
631
|
143 if (type_tag == TC_REP::matrix_constant) \ |
|
492
|
144 (m).resize ((nr), (nc)); \ |
|
|
145 else if (type_tag == complex_matrix_constant) \ |
|
|
146 (cm).resize ((nr), (nc)); \ |
|
|
147 else \ |
|
|
148 abort (); \ |
|
|
149 |
|
|
150 // Assign a real or complex matrix to a tree constant. |
|
|
151 |
|
|
152 // This macro only makes sense inside a friend or member function of |
|
|
153 // the tree_constant_rep class. |
|
|
154 |
|
|
155 #define ASSIGN_CRMATRIX_TO(tc,m,cm) \ |
|
|
156 do \ |
|
|
157 { \ |
|
|
158 if (type_tag == matrix_constant) \ |
|
|
159 tc = tree_constant (m); \ |
|
|
160 else \ |
|
|
161 tc = tree_constant (cm); \ |
|
|
162 } \ |
|
|
163 while (0) |
|
|
164 |
|
|
165 // Assign an element of this tree_constant_rep's real or complex |
|
|
166 // matrix to another real or complex matrix. |
|
|
167 |
|
|
168 // This macro only makes sense inside a friend or member function of |
|
|
169 // the tree_constant_rep class. |
|
|
170 |
|
|
171 #define CRMATRIX_ASSIGN_REP_ELEM(m,cm,i1,j1,i2,j2) \ |
|
|
172 do \ |
|
|
173 { \ |
|
|
174 if (type_tag == matrix_constant) \ |
|
|
175 (m).elem ((i1), (j1)) = matrix->elem ((i2), (j2)); \ |
|
|
176 else \ |
|
|
177 (cm).elem ((i1), (j1)) = complex_matrix->elem ((i2), (j2)); \ |
|
|
178 } \ |
|
|
179 while (0) |
|
|
180 |
|
|
181 // Assign a value to an element of a real or complex matrix. Assumes |
|
|
182 // that the lhs and rhs are either both real or both complex types. |
|
|
183 |
|
|
184 #define CRMATRIX_ASSIGN_ELEM(m,cm,i,j,rval,cval,real_type) \ |
|
|
185 do \ |
|
|
186 { \ |
|
|
187 if (real_type) \ |
|
|
188 (m).elem ((i), (j)) = (rval); \ |
|
|
189 else \ |
|
|
190 (cm).elem ((i), (j)) = (cval); \ |
|
|
191 } \ |
|
|
192 while (0) |
|
|
193 |
|
|
194 |
|
|
195 // A couple of handy helper functions. |
|
|
196 |
|
|
197 static int |
|
|
198 any_element_less_than (const Matrix& a, double val) |
|
|
199 { |
|
|
200 int nr = a.rows (); |
|
|
201 int nc = a.columns (); |
|
|
202 for (int j = 0; j < nc; j++) |
|
|
203 for (int i = 0; i < nr; i++) |
|
|
204 if (a.elem (i, j) < val) |
|
|
205 return 1; |
|
|
206 return 0; |
|
|
207 } |
|
|
208 |
|
|
209 static int |
|
|
210 any_element_greater_than (const Matrix& a, double val) |
|
|
211 { |
|
|
212 int nr = a.rows (); |
|
|
213 int nc = a.columns (); |
|
|
214 for (int j = 0; j < nc; j++) |
|
|
215 for (int i = 0; i < nr; i++) |
|
|
216 if (a.elem (i, j) > val) |
|
|
217 return 1; |
|
|
218 return 0; |
|
|
219 } |
|
|
220 |
|
|
221 static int |
|
|
222 any_element_is_complex (const ComplexMatrix& a) |
|
|
223 { |
|
|
224 int nr = a.rows (); |
|
|
225 int nc = a.columns (); |
|
|
226 for (int j = 0; j < nc; j++) |
|
|
227 for (int i = 0; i < nr; i++) |
|
|
228 if (imag (a.elem (i, j)) != 0.0) |
|
|
229 return 1; |
|
|
230 return 0; |
|
|
231 } |
|
|
232 |
|
581
|
233 static int |
|
|
234 valid_scalar_indices (const Octave_object& args) |
|
|
235 { |
|
|
236 int nargin = args.length (); |
|
|
237 |
|
|
238 return ((nargin == 3 |
|
|
239 && args(2).valid_as_scalar_index () |
|
|
240 && args(1).valid_as_scalar_index ()) |
|
|
241 || (nargin == 2 |
|
|
242 && args(1).valid_as_scalar_index ())); |
|
|
243 } |
|
|
244 |
|
492
|
245 // Now, the classes. |
|
|
246 |
|
581
|
247 // The real representation of constants. |
|
|
248 |
|
631
|
249 TC_REP::tree_constant_rep (void) |
|
492
|
250 { |
|
|
251 type_tag = unknown_constant; |
|
581
|
252 orig_text = 0; |
|
492
|
253 } |
|
|
254 |
|
631
|
255 TC_REP::tree_constant_rep (double d) |
|
492
|
256 { |
|
|
257 scalar = d; |
|
|
258 type_tag = scalar_constant; |
|
581
|
259 orig_text = 0; |
|
492
|
260 } |
|
|
261 |
|
631
|
262 TC_REP::tree_constant_rep (const Matrix& m) |
|
492
|
263 { |
|
|
264 if (m.rows () == 1 && m.columns () == 1) |
|
|
265 { |
|
|
266 scalar = m.elem (0, 0); |
|
|
267 type_tag = scalar_constant; |
|
|
268 } |
|
|
269 else |
|
|
270 { |
|
|
271 matrix = new Matrix (m); |
|
|
272 type_tag = matrix_constant; |
|
|
273 } |
|
581
|
274 orig_text = 0; |
|
492
|
275 } |
|
|
276 |
|
631
|
277 TC_REP::tree_constant_rep (const DiagMatrix& d) |
|
492
|
278 { |
|
|
279 if (d.rows () == 1 && d.columns () == 1) |
|
|
280 { |
|
|
281 scalar = d.elem (0, 0); |
|
|
282 type_tag = scalar_constant; |
|
|
283 } |
|
|
284 else |
|
|
285 { |
|
|
286 matrix = new Matrix (d); |
|
|
287 type_tag = matrix_constant; |
|
|
288 } |
|
581
|
289 orig_text = 0; |
|
492
|
290 } |
|
|
291 |
|
631
|
292 TC_REP::tree_constant_rep (const RowVector& v, int prefer_column_vector) |
|
492
|
293 { |
|
|
294 int len = v.capacity (); |
|
|
295 if (len == 1) |
|
|
296 { |
|
|
297 scalar = v.elem (0); |
|
|
298 type_tag = scalar_constant; |
|
|
299 } |
|
|
300 else |
|
|
301 { |
|
|
302 int pcv = (prefer_column_vector < 0) |
|
|
303 ? user_pref.prefer_column_vectors |
|
|
304 : prefer_column_vector; |
|
|
305 |
|
|
306 if (pcv) |
|
|
307 { |
|
|
308 Matrix m (len, 1); |
|
|
309 for (int i = 0; i < len; i++) |
|
|
310 m.elem (i, 0) = v.elem (i); |
|
|
311 matrix = new Matrix (m); |
|
|
312 type_tag = matrix_constant; |
|
|
313 } |
|
|
314 else |
|
|
315 { |
|
|
316 Matrix m (1, len); |
|
|
317 for (int i = 0; i < len; i++) |
|
|
318 m.elem (0, i) = v.elem (i); |
|
|
319 matrix = new Matrix (m); |
|
|
320 type_tag = matrix_constant; |
|
|
321 } |
|
|
322 } |
|
581
|
323 orig_text = 0; |
|
492
|
324 } |
|
|
325 |
|
631
|
326 TC_REP::tree_constant_rep (const ColumnVector& v, int prefer_column_vector) |
|
492
|
327 { |
|
|
328 int len = v.capacity (); |
|
|
329 if (len == 1) |
|
|
330 { |
|
|
331 scalar = v.elem (0); |
|
|
332 type_tag = scalar_constant; |
|
|
333 } |
|
|
334 else |
|
|
335 { |
|
|
336 int pcv = (prefer_column_vector < 0) |
|
|
337 ? user_pref.prefer_column_vectors |
|
|
338 : prefer_column_vector; |
|
|
339 |
|
|
340 if (pcv) |
|
|
341 { |
|
|
342 Matrix m (len, 1); |
|
|
343 for (int i = 0; i < len; i++) |
|
|
344 m.elem (i, 0) = v.elem (i); |
|
|
345 matrix = new Matrix (m); |
|
|
346 type_tag = matrix_constant; |
|
|
347 } |
|
|
348 else |
|
|
349 { |
|
|
350 Matrix m (1, len); |
|
|
351 for (int i = 0; i < len; i++) |
|
|
352 m.elem (0, i) = v.elem (i); |
|
|
353 matrix = new Matrix (m); |
|
|
354 type_tag = matrix_constant; |
|
|
355 } |
|
|
356 } |
|
581
|
357 orig_text = 0; |
|
492
|
358 } |
|
|
359 |
|
631
|
360 TC_REP::tree_constant_rep (const Complex& c) |
|
492
|
361 { |
|
|
362 complex_scalar = new Complex (c); |
|
|
363 type_tag = complex_scalar_constant; |
|
581
|
364 orig_text = 0; |
|
492
|
365 } |
|
|
366 |
|
631
|
367 TC_REP::tree_constant_rep (const ComplexMatrix& m) |
|
492
|
368 { |
|
|
369 if (m.rows () == 1 && m.columns () == 1) |
|
|
370 { |
|
|
371 complex_scalar = new Complex (m.elem (0, 0)); |
|
|
372 type_tag = complex_scalar_constant; |
|
|
373 } |
|
|
374 else |
|
|
375 { |
|
|
376 complex_matrix = new ComplexMatrix (m); |
|
|
377 type_tag = complex_matrix_constant; |
|
|
378 } |
|
581
|
379 orig_text = 0; |
|
492
|
380 } |
|
|
381 |
|
631
|
382 TC_REP::tree_constant_rep (const ComplexDiagMatrix& d) |
|
492
|
383 { |
|
|
384 if (d.rows () == 1 && d.columns () == 1) |
|
|
385 { |
|
|
386 complex_scalar = new Complex (d.elem (0, 0)); |
|
|
387 type_tag = complex_scalar_constant; |
|
|
388 } |
|
|
389 else |
|
|
390 { |
|
|
391 complex_matrix = new ComplexMatrix (d); |
|
|
392 type_tag = complex_matrix_constant; |
|
|
393 } |
|
581
|
394 orig_text = 0; |
|
492
|
395 } |
|
|
396 |
|
631
|
397 TC_REP::tree_constant_rep (const ComplexRowVector& v, |
|
|
398 int prefer_column_vector) |
|
492
|
399 { |
|
|
400 int len = v.capacity (); |
|
|
401 if (len == 1) |
|
|
402 { |
|
|
403 complex_scalar = new Complex (v.elem (0)); |
|
|
404 type_tag = complex_scalar_constant; |
|
|
405 } |
|
|
406 else |
|
|
407 { |
|
|
408 int pcv = (prefer_column_vector < 0) |
|
|
409 ? user_pref.prefer_column_vectors |
|
|
410 : prefer_column_vector; |
|
|
411 |
|
|
412 if (pcv) |
|
|
413 { |
|
|
414 ComplexMatrix m (len, 1); |
|
|
415 for (int i = 0; i < len; i++) |
|
|
416 m.elem (i, 0) = v.elem (i); |
|
|
417 complex_matrix = new ComplexMatrix (m); |
|
|
418 type_tag = complex_matrix_constant; |
|
|
419 } |
|
|
420 else |
|
|
421 { |
|
|
422 ComplexMatrix m (1, len); |
|
|
423 for (int i = 0; i < len; i++) |
|
|
424 m.elem (0, i) = v.elem (i); |
|
|
425 complex_matrix = new ComplexMatrix (m); |
|
|
426 type_tag = complex_matrix_constant; |
|
|
427 } |
|
|
428 } |
|
581
|
429 orig_text = 0; |
|
492
|
430 } |
|
|
431 |
|
631
|
432 TC_REP::tree_constant_rep (const ComplexColumnVector& v, int |
|
|
433 prefer_column_vector) |
|
492
|
434 { |
|
|
435 int len = v.capacity (); |
|
|
436 if (len == 1) |
|
|
437 { |
|
|
438 complex_scalar = new Complex (v.elem (0)); |
|
|
439 type_tag = complex_scalar_constant; |
|
|
440 } |
|
|
441 else |
|
|
442 { |
|
|
443 int pcv = (prefer_column_vector < 0) |
|
|
444 ? user_pref.prefer_column_vectors |
|
|
445 : prefer_column_vector; |
|
|
446 |
|
|
447 if (pcv) |
|
|
448 { |
|
|
449 ComplexMatrix m (len, 1); |
|
|
450 for (int i = 0; i < len; i++) |
|
|
451 m.elem (i, 0) = v.elem (i); |
|
|
452 complex_matrix = new ComplexMatrix (m); |
|
|
453 type_tag = complex_matrix_constant; |
|
|
454 } |
|
|
455 else |
|
|
456 { |
|
|
457 ComplexMatrix m (1, len); |
|
|
458 for (int i = 0; i < len; i++) |
|
|
459 m.elem (0, i) = v.elem (i); |
|
|
460 complex_matrix = new ComplexMatrix (m); |
|
|
461 type_tag = complex_matrix_constant; |
|
|
462 } |
|
|
463 } |
|
581
|
464 orig_text = 0; |
|
492
|
465 } |
|
|
466 |
|
631
|
467 TC_REP::tree_constant_rep (const char *s) |
|
492
|
468 { |
|
|
469 string = strsave (s); |
|
|
470 type_tag = string_constant; |
|
581
|
471 orig_text = 0; |
|
492
|
472 } |
|
|
473 |
|
631
|
474 TC_REP::tree_constant_rep (double b, double l, double i) |
|
492
|
475 { |
|
|
476 range = new Range (b, l, i); |
|
|
477 int nel = range->nelem (); |
|
|
478 if (nel < 0) |
|
|
479 { |
|
|
480 delete range; |
|
|
481 type_tag = unknown_constant; |
|
|
482 if (nel == -1) |
|
|
483 ::error ("number of elements in range exceeds INT_MAX"); |
|
|
484 else |
|
|
485 ::error ("invalid range"); |
|
|
486 } |
|
|
487 else if (nel > 1) |
|
|
488 type_tag = range_constant; |
|
|
489 else |
|
|
490 { |
|
|
491 delete range; |
|
|
492 if (nel == 1) |
|
|
493 { |
|
|
494 scalar = b; |
|
|
495 type_tag = scalar_constant; |
|
|
496 } |
|
|
497 else if (nel == 0) |
|
|
498 { |
|
|
499 matrix = new Matrix (); |
|
|
500 type_tag = matrix_constant; |
|
|
501 } |
|
|
502 else |
|
|
503 panic_impossible (); |
|
|
504 } |
|
581
|
505 orig_text = 0; |
|
492
|
506 } |
|
|
507 |
|
631
|
508 TC_REP::tree_constant_rep (const Range& r) |
|
492
|
509 { |
|
|
510 if (r.nelem () > 1) |
|
|
511 { |
|
|
512 range = new Range (r); |
|
|
513 type_tag = range_constant; |
|
|
514 } |
|
|
515 else if (r.nelem () == 1) |
|
|
516 { |
|
|
517 scalar = r.base (); |
|
|
518 type_tag = scalar_constant; |
|
|
519 } |
|
|
520 else if (r.nelem () == 0) |
|
|
521 { |
|
|
522 matrix = new Matrix (); |
|
|
523 type_tag = matrix_constant; |
|
|
524 } |
|
|
525 else |
|
|
526 panic_impossible (); |
|
581
|
527 |
|
|
528 orig_text = 0; |
|
492
|
529 } |
|
|
530 |
|
631
|
531 TC_REP::tree_constant_rep (TC_REP::constant_type t) |
|
492
|
532 { |
|
|
533 assert (t == magic_colon); |
|
|
534 type_tag = magic_colon; |
|
581
|
535 orig_text = 0; |
|
492
|
536 } |
|
|
537 |
|
631
|
538 TC_REP::tree_constant_rep (const tree_constant_rep& t) |
|
492
|
539 { |
|
|
540 type_tag = t.type_tag; |
|
|
541 |
|
|
542 switch (t.type_tag) |
|
|
543 { |
|
|
544 case unknown_constant: |
|
|
545 break; |
|
631
|
546 |
|
492
|
547 case scalar_constant: |
|
|
548 scalar = t.scalar; |
|
|
549 break; |
|
631
|
550 |
|
492
|
551 case matrix_constant: |
|
|
552 matrix = new Matrix (*(t.matrix)); |
|
|
553 break; |
|
631
|
554 |
|
492
|
555 case string_constant: |
|
|
556 string = strsave (t.string); |
|
|
557 break; |
|
631
|
558 |
|
492
|
559 case complex_matrix_constant: |
|
|
560 complex_matrix = new ComplexMatrix (*(t.complex_matrix)); |
|
|
561 break; |
|
631
|
562 |
|
492
|
563 case complex_scalar_constant: |
|
|
564 complex_scalar = new Complex (*(t.complex_scalar)); |
|
|
565 break; |
|
631
|
566 |
|
492
|
567 case range_constant: |
|
|
568 range = new Range (*(t.range)); |
|
|
569 break; |
|
631
|
570 |
|
492
|
571 case magic_colon: |
|
|
572 break; |
|
631
|
573 |
|
492
|
574 default: |
|
|
575 panic_impossible (); |
|
|
576 break; |
|
|
577 } |
|
581
|
578 |
|
|
579 orig_text = strsave (t.orig_text); |
|
492
|
580 } |
|
|
581 |
|
631
|
582 TC_REP::~tree_constant_rep (void) |
|
492
|
583 { |
|
|
584 switch (type_tag) |
|
|
585 { |
|
|
586 case unknown_constant: |
|
|
587 case scalar_constant: |
|
631
|
588 case magic_colon: |
|
|
589 break; |
|
|
590 |
|
492
|
591 case matrix_constant: |
|
|
592 delete matrix; |
|
|
593 break; |
|
631
|
594 |
|
492
|
595 case complex_scalar_constant: |
|
|
596 delete complex_scalar; |
|
|
597 break; |
|
631
|
598 |
|
492
|
599 case complex_matrix_constant: |
|
|
600 delete complex_matrix; |
|
|
601 break; |
|
631
|
602 |
|
492
|
603 case string_constant: |
|
|
604 delete [] string; |
|
|
605 break; |
|
631
|
606 |
|
492
|
607 case range_constant: |
|
|
608 delete range; |
|
|
609 break; |
|
631
|
610 |
|
492
|
611 default: |
|
|
612 panic_impossible (); |
|
|
613 break; |
|
|
614 } |
|
581
|
615 |
|
|
616 delete [] orig_text; |
|
492
|
617 } |
|
|
618 |
|
|
619 #if defined (MDEBUG) |
|
|
620 void * |
|
631
|
621 TC_REP::operator new (size_t size) |
|
492
|
622 { |
|
|
623 tree_constant_rep *p = ::new tree_constant_rep; |
|
631
|
624 cerr << "TC_REP::new(): " << p << "\n"; |
|
492
|
625 return p; |
|
|
626 } |
|
|
627 |
|
|
628 void |
|
631
|
629 TC_REP::operator delete (void *p, size_t size) |
|
492
|
630 { |
|
631
|
631 cerr << "TC_REP::delete(): " << p << "\n"; |
|
492
|
632 ::delete p; |
|
|
633 } |
|
|
634 #endif |
|
|
635 |
|
631
|
636 int |
|
|
637 TC_REP::rows (void) const |
|
492
|
638 { |
|
631
|
639 int retval = -1; |
|
581
|
640 |
|
|
641 switch (type_tag) |
|
|
642 { |
|
|
643 case scalar_constant: |
|
|
644 case complex_scalar_constant: |
|
631
|
645 retval = 1; |
|
|
646 break; |
|
|
647 |
|
581
|
648 case string_constant: |
|
|
649 case range_constant: |
|
631
|
650 retval = (columns () > 0); |
|
|
651 break; |
|
|
652 |
|
|
653 case matrix_constant: |
|
|
654 retval = matrix->rows (); |
|
|
655 break; |
|
|
656 |
|
|
657 case complex_matrix_constant: |
|
|
658 retval = complex_matrix->rows (); |
|
|
659 break; |
|
|
660 |
|
581
|
661 case magic_colon: |
|
631
|
662 ::error ("invalid use of colon operator"); |
|
|
663 break; |
|
|
664 |
|
|
665 case unknown_constant: |
|
|
666 retval = 0; |
|
|
667 break; |
|
|
668 |
|
492
|
669 default: |
|
|
670 panic_impossible (); |
|
|
671 break; |
|
|
672 } |
|
|
673 |
|
|
674 return retval; |
|
|
675 } |
|
|
676 |
|
|
677 int |
|
631
|
678 TC_REP::columns (void) const |
|
492
|
679 { |
|
|
680 int retval = -1; |
|
631
|
681 |
|
492
|
682 switch (type_tag) |
|
|
683 { |
|
|
684 case scalar_constant: |
|
|
685 case complex_scalar_constant: |
|
|
686 retval = 1; |
|
|
687 break; |
|
631
|
688 |
|
492
|
689 case matrix_constant: |
|
631
|
690 retval = matrix->columns (); |
|
|
691 break; |
|
|
692 |
|
492
|
693 case complex_matrix_constant: |
|
631
|
694 retval = complex_matrix->columns (); |
|
|
695 break; |
|
|
696 |
|
|
697 case string_constant: |
|
|
698 retval = strlen (string); |
|
|
699 break; |
|
|
700 |
|
|
701 case range_constant: |
|
|
702 retval = range->nelem (); |
|
|
703 break; |
|
|
704 |
|
492
|
705 case magic_colon: |
|
|
706 ::error ("invalid use of colon operator"); |
|
|
707 break; |
|
631
|
708 |
|
492
|
709 case unknown_constant: |
|
|
710 retval = 0; |
|
|
711 break; |
|
631
|
712 |
|
492
|
713 default: |
|
|
714 panic_impossible (); |
|
|
715 break; |
|
|
716 } |
|
631
|
717 |
|
492
|
718 return retval; |
|
|
719 } |
|
|
720 |
|
|
721 tree_constant |
|
631
|
722 TC_REP::all (void) const |
|
492
|
723 { |
|
|
724 if (type_tag == string_constant || type_tag == range_constant) |
|
|
725 { |
|
|
726 tree_constant tmp = make_numeric (); |
|
|
727 return tmp.all (); |
|
|
728 } |
|
|
729 |
|
|
730 tree_constant retval; |
|
631
|
731 |
|
492
|
732 switch (type_tag) |
|
|
733 { |
|
|
734 case scalar_constant: |
|
|
735 { |
|
|
736 double status = (scalar != 0.0); |
|
|
737 retval = tree_constant (status); |
|
|
738 } |
|
|
739 break; |
|
631
|
740 |
|
492
|
741 case matrix_constant: |
|
|
742 { |
|
|
743 Matrix m = matrix->all (); |
|
|
744 retval = tree_constant (m); |
|
|
745 } |
|
|
746 break; |
|
631
|
747 |
|
492
|
748 case complex_scalar_constant: |
|
|
749 { |
|
|
750 double status = (*complex_scalar != 0.0); |
|
|
751 retval = tree_constant (status); |
|
|
752 } |
|
|
753 break; |
|
631
|
754 |
|
492
|
755 case complex_matrix_constant: |
|
|
756 { |
|
|
757 Matrix m = complex_matrix->all (); |
|
|
758 retval = tree_constant (m); |
|
|
759 } |
|
|
760 break; |
|
631
|
761 |
|
492
|
762 case string_constant: |
|
|
763 case range_constant: |
|
|
764 case magic_colon: |
|
|
765 default: |
|
|
766 panic_impossible (); |
|
|
767 break; |
|
|
768 } |
|
631
|
769 |
|
492
|
770 return retval; |
|
|
771 } |
|
|
772 |
|
|
773 tree_constant |
|
631
|
774 TC_REP::any (void) const |
|
492
|
775 { |
|
|
776 if (type_tag == string_constant || type_tag == range_constant) |
|
|
777 { |
|
|
778 tree_constant tmp = make_numeric (); |
|
|
779 return tmp.any (); |
|
|
780 } |
|
|
781 |
|
|
782 tree_constant retval; |
|
631
|
783 |
|
492
|
784 switch (type_tag) |
|
|
785 { |
|
|
786 case scalar_constant: |
|
|
787 { |
|
|
788 double status = (scalar != 0.0); |
|
|
789 retval = tree_constant (status); |
|
|
790 } |
|
|
791 break; |
|
631
|
792 |
|
492
|
793 case matrix_constant: |
|
|
794 { |
|
|
795 Matrix m = matrix->any (); |
|
|
796 retval = tree_constant (m); |
|
|
797 } |
|
|
798 break; |
|
631
|
799 |
|
492
|
800 case complex_scalar_constant: |
|
|
801 { |
|
|
802 double status = (*complex_scalar != 0.0); |
|
|
803 retval = tree_constant (status); |
|
|
804 } |
|
|
805 break; |
|
631
|
806 |
|
492
|
807 case complex_matrix_constant: |
|
|
808 { |
|
|
809 Matrix m = complex_matrix->any (); |
|
|
810 retval = tree_constant (m); |
|
|
811 } |
|
|
812 break; |
|
631
|
813 |
|
|
814 case string_constant: |
|
|
815 case range_constant: |
|
|
816 case magic_colon: |
|
|
817 default: |
|
|
818 panic_impossible (); |
|
|
819 break; |
|
|
820 } |
|
|
821 |
|
|
822 return retval; |
|
|
823 } |
|
|
824 |
|
|
825 int |
|
|
826 TC_REP::valid_as_scalar_index (void) const |
|
|
827 { |
|
|
828 return (type_tag == magic_colon |
|
|
829 || (type_tag == scalar_constant && NINT (scalar) == 1) |
|
|
830 || (type_tag == range_constant |
|
|
831 && range->nelem () == 1 && NINT (range->base ()) == 1)); |
|
|
832 } |
|
|
833 |
|
|
834 int |
|
|
835 TC_REP::is_true (void) const |
|
|
836 { |
|
|
837 if (type_tag == string_constant || type_tag == range_constant) |
|
|
838 { |
|
|
839 tree_constant tmp = make_numeric (); |
|
|
840 return tmp.is_true (); |
|
|
841 } |
|
|
842 |
|
|
843 int retval; |
|
|
844 |
|
|
845 switch (type_tag) |
|
|
846 { |
|
|
847 case scalar_constant: |
|
|
848 retval = (scalar != 0.0); |
|
|
849 break; |
|
|
850 |
|
|
851 case matrix_constant: |
|
|
852 { |
|
|
853 Matrix m = (matrix->all ()) . all (); |
|
|
854 retval = (m.rows () == 1 |
|
|
855 && m.columns () == 1 |
|
|
856 && m.elem (0, 0) != 0.0); |
|
|
857 } |
|
|
858 break; |
|
|
859 |
|
|
860 case complex_scalar_constant: |
|
|
861 retval = (*complex_scalar != 0.0); |
|
|
862 break; |
|
|
863 |
|
|
864 case complex_matrix_constant: |
|
|
865 { |
|
|
866 Matrix m = (complex_matrix->all ()) . all (); |
|
|
867 retval = (m.rows () == 1 |
|
|
868 && m.columns () == 1 |
|
|
869 && m.elem (0, 0) != 0.0); |
|
|
870 } |
|
|
871 break; |
|
|
872 |
|
492
|
873 case string_constant: |
|
|
874 case range_constant: |
|
|
875 case magic_colon: |
|
|
876 default: |
|
|
877 panic_impossible (); |
|
|
878 break; |
|
|
879 } |
|
631
|
880 |
|
|
881 return retval; |
|
|
882 } |
|
|
883 |
|
|
884 static void |
|
|
885 warn_implicit_conversion (const char *from, const char *to) |
|
|
886 { |
|
|
887 warning ("implicit conversion from %s to %s", from, to); |
|
|
888 } |
|
|
889 |
|
|
890 double |
|
|
891 TC_REP::double_value (int force_string_conversion) const |
|
|
892 { |
|
|
893 double retval = octave_NaN; |
|
|
894 |
|
|
895 switch (type_tag) |
|
|
896 { |
|
|
897 case scalar_constant: |
|
|
898 retval = scalar; |
|
|
899 break; |
|
|
900 |
|
|
901 case matrix_constant: |
|
|
902 { |
|
|
903 if (user_pref.do_fortran_indexing && rows () > 0 && columns () > 0) |
|
|
904 retval = matrix->elem (0, 0); |
|
|
905 else |
|
|
906 gripe_invalid_conversion ("real matrix", "real scalar"); |
|
|
907 } |
|
|
908 break; |
|
|
909 |
|
|
910 case complex_matrix_constant: |
|
|
911 case complex_scalar_constant: |
|
|
912 { |
|
|
913 int flag = user_pref.ok_to_lose_imaginary_part; |
|
|
914 |
|
|
915 if (flag < 0) |
|
|
916 warn_implicit_conversion ("complex scalar", "real scalar"); |
|
|
917 |
|
|
918 if (flag) |
|
|
919 { |
|
|
920 if (type_tag == complex_scalar_constant) |
|
|
921 retval = ::real (*complex_scalar); |
|
|
922 else if (type_tag == complex_matrix_constant) |
|
|
923 { |
|
|
924 if (user_pref.do_fortran_indexing |
|
|
925 && rows () > 0 && columns () > 0) |
|
|
926 retval = ::real (complex_matrix->elem (0, 0)); |
|
|
927 else |
|
|
928 gripe_invalid_conversion ("complex matrix", "real scalar"); |
|
|
929 } |
|
|
930 else |
|
|
931 panic_impossible (); |
|
|
932 } |
|
|
933 else |
|
|
934 gripe_invalid_conversion ("complex scalar", "real scalar"); |
|
|
935 } |
|
|
936 break; |
|
|
937 |
|
|
938 case string_constant: |
|
|
939 { |
|
|
940 int flag = force_string_conversion; |
|
|
941 if (! flag) |
|
|
942 flag = user_pref.implicit_str_to_num_ok; |
|
|
943 |
|
|
944 if (flag < 0) |
|
|
945 warn_implicit_conversion ("string", "real scalar"); |
|
|
946 |
|
|
947 int len = strlen (string); |
|
|
948 if (flag && (len == 1 || (len > 1 && user_pref.do_fortran_indexing))) |
|
|
949 retval = toascii ((int) string[0]); |
|
|
950 else |
|
|
951 gripe_invalid_conversion ("string", "real scalar"); |
|
|
952 } |
|
|
953 break; |
|
|
954 |
|
|
955 case range_constant: |
|
|
956 { |
|
|
957 int nel = range->nelem (); |
|
|
958 if (nel == 1 || (nel > 1 && user_pref.do_fortran_indexing)) |
|
|
959 retval = range->base (); |
|
|
960 else |
|
|
961 gripe_invalid_conversion ("range", "real scalar"); |
|
|
962 } |
|
|
963 break; |
|
|
964 |
|
|
965 default: |
|
|
966 gripe_invalid_conversion (type_as_string (), "real scalar"); |
|
|
967 break; |
|
|
968 } |
|
|
969 |
|
|
970 return retval; |
|
|
971 } |
|
|
972 |
|
|
973 Matrix |
|
|
974 TC_REP::matrix_value (int force_string_conversion) const |
|
|
975 { |
|
|
976 Matrix retval; |
|
|
977 |
|
|
978 switch (type_tag) |
|
|
979 { |
|
|
980 case scalar_constant: |
|
|
981 retval = Matrix (1, 1, scalar); |
|
|
982 break; |
|
|
983 |
|
|
984 case matrix_constant: |
|
|
985 retval = *matrix; |
|
|
986 break; |
|
|
987 |
|
|
988 case complex_scalar_constant: |
|
|
989 case complex_matrix_constant: |
|
|
990 { |
|
|
991 int flag = user_pref.ok_to_lose_imaginary_part; |
|
|
992 if (flag < 0) |
|
|
993 warn_implicit_conversion ("complex matrix", "real matrix"); |
|
|
994 |
|
|
995 if (flag) |
|
|
996 { |
|
|
997 if (type_tag == complex_scalar_constant) |
|
|
998 retval = Matrix (1, 1, ::real (*complex_scalar)); |
|
|
999 else if (type_tag == complex_matrix_constant) |
|
|
1000 retval = ::real (*complex_matrix); |
|
|
1001 else |
|
|
1002 panic_impossible (); |
|
|
1003 } |
|
|
1004 else |
|
|
1005 gripe_invalid_conversion ("complex matrix", "real matrix"); |
|
|
1006 } |
|
|
1007 break; |
|
|
1008 |
|
|
1009 case string_constant: |
|
|
1010 { |
|
|
1011 int flag = force_string_conversion; |
|
|
1012 if (! flag) |
|
|
1013 flag = user_pref.implicit_str_to_num_ok; |
|
|
1014 |
|
|
1015 if (flag < 0) |
|
|
1016 warn_implicit_conversion ("string", "real matrix"); |
|
|
1017 |
|
|
1018 if (flag) |
|
|
1019 { |
|
|
1020 int len = strlen (string); |
|
|
1021 |
|
|
1022 retval.resize (1, len); |
|
|
1023 |
|
|
1024 if (len > 1) |
|
|
1025 { |
|
|
1026 for (int i = 0; i < len; i++) |
|
|
1027 retval.elem (0, i) = toascii ((int) string[i]); |
|
|
1028 } |
|
|
1029 else if (len == 1) |
|
|
1030 retval.elem (0, 0) = toascii ((int) string[0]); |
|
|
1031 else |
|
|
1032 panic_impossible (); |
|
|
1033 } |
|
|
1034 else |
|
|
1035 gripe_invalid_conversion ("string", "real matrix"); |
|
|
1036 } |
|
|
1037 break; |
|
|
1038 |
|
|
1039 case range_constant: |
|
|
1040 retval = range->matrix_value (); |
|
|
1041 break; |
|
|
1042 |
|
|
1043 default: |
|
|
1044 gripe_invalid_conversion (type_as_string (), "real matrix"); |
|
|
1045 break; |
|
|
1046 } |
|
|
1047 |
|
|
1048 return retval; |
|
|
1049 } |
|
|
1050 |
|
|
1051 Complex |
|
|
1052 TC_REP::complex_value (int force_string_conversion) const |
|
|
1053 { |
|
636
|
1054 Complex retval (octave_NaN, octave_NaN); |
|
631
|
1055 |
|
|
1056 switch (type_tag) |
|
|
1057 { |
|
|
1058 case complex_scalar_constant: |
|
|
1059 retval = *complex_scalar; |
|
|
1060 break; |
|
|
1061 |
|
|
1062 case scalar_constant: |
|
|
1063 retval = scalar; |
|
|
1064 break; |
|
|
1065 |
|
|
1066 case complex_matrix_constant: |
|
|
1067 case matrix_constant: |
|
|
1068 { |
|
|
1069 if (user_pref.do_fortran_indexing && rows () > 0 && columns () > 0) |
|
|
1070 { |
|
|
1071 if (type_tag == complex_matrix_constant) |
|
|
1072 retval = complex_matrix->elem (0, 0); |
|
|
1073 else |
|
|
1074 retval = matrix->elem (0, 0); |
|
|
1075 } |
|
|
1076 else |
|
|
1077 gripe_invalid_conversion ("real matrix", "real scalar"); |
|
|
1078 } |
|
|
1079 break; |
|
|
1080 |
|
|
1081 case string_constant: |
|
|
1082 { |
|
|
1083 int flag = force_string_conversion; |
|
|
1084 if (! flag) |
|
|
1085 flag = user_pref.implicit_str_to_num_ok; |
|
|
1086 |
|
|
1087 if (flag < 0) |
|
|
1088 warn_implicit_conversion ("string", "complex scalar"); |
|
|
1089 |
|
|
1090 int len = strlen (string); |
|
|
1091 if (flag && (len == 1 || (len > 1 && user_pref.do_fortran_indexing))) |
|
|
1092 retval = toascii ((int) string[0]); |
|
|
1093 else |
|
|
1094 gripe_invalid_conversion ("string", "complex scalar"); |
|
|
1095 } |
|
|
1096 break; |
|
|
1097 |
|
|
1098 case range_constant: |
|
|
1099 { |
|
|
1100 int nel = range->nelem (); |
|
|
1101 if (nel == 1 || (nel > 1 && user_pref.do_fortran_indexing)) |
|
|
1102 retval = range->base (); |
|
|
1103 else |
|
|
1104 gripe_invalid_conversion ("range", "complex scalar"); |
|
|
1105 } |
|
|
1106 break; |
|
|
1107 |
|
|
1108 default: |
|
|
1109 gripe_invalid_conversion (type_as_string (), "complex scalar"); |
|
|
1110 break; |
|
|
1111 } |
|
|
1112 |
|
|
1113 return retval; |
|
|
1114 } |
|
|
1115 |
|
|
1116 ComplexMatrix |
|
|
1117 TC_REP::complex_matrix_value (int force_string_conversion) const |
|
|
1118 { |
|
|
1119 ComplexMatrix retval; |
|
|
1120 |
|
|
1121 switch (type_tag) |
|
|
1122 { |
|
|
1123 case scalar_constant: |
|
|
1124 retval = ComplexMatrix (1, 1, Complex (scalar)); |
|
|
1125 break; |
|
|
1126 |
|
|
1127 case complex_scalar_constant: |
|
|
1128 retval = ComplexMatrix (1, 1, *complex_scalar); |
|
|
1129 break; |
|
|
1130 |
|
|
1131 case matrix_constant: |
|
|
1132 retval = ComplexMatrix (*matrix); |
|
|
1133 break; |
|
|
1134 |
|
|
1135 case complex_matrix_constant: |
|
|
1136 retval = *complex_matrix; |
|
|
1137 break; |
|
|
1138 |
|
|
1139 case string_constant: |
|
|
1140 { |
|
|
1141 int flag = force_string_conversion; |
|
|
1142 if (! flag) |
|
|
1143 flag = user_pref.implicit_str_to_num_ok; |
|
|
1144 |
|
|
1145 if (flag < 0) |
|
|
1146 warn_implicit_conversion ("string", "complex matrix"); |
|
|
1147 |
|
|
1148 if (flag) |
|
|
1149 { |
|
|
1150 int len = strlen (string); |
|
|
1151 |
|
|
1152 retval.resize (1, len); |
|
|
1153 |
|
|
1154 if (len > 1) |
|
|
1155 { |
|
|
1156 for (int i = 0; i < len; i++) |
|
|
1157 retval.elem (0, i) = toascii ((int) string[i]); |
|
|
1158 } |
|
|
1159 else if (len == 1) |
|
|
1160 retval.elem (0, 0) = toascii ((int) string[0]); |
|
|
1161 else |
|
|
1162 panic_impossible (); |
|
|
1163 } |
|
|
1164 else |
|
|
1165 gripe_invalid_conversion ("string", "real matrix"); |
|
|
1166 } |
|
|
1167 break; |
|
|
1168 |
|
|
1169 case range_constant: |
|
|
1170 retval = range->matrix_value (); |
|
|
1171 break; |
|
|
1172 |
|
|
1173 default: |
|
|
1174 gripe_invalid_conversion (type_as_string (), "complex matrix"); |
|
|
1175 break; |
|
|
1176 } |
|
|
1177 |
|
|
1178 return retval; |
|
|
1179 } |
|
|
1180 |
|
|
1181 char * |
|
|
1182 TC_REP::string_value (void) const |
|
|
1183 { |
|
636
|
1184 if (type_tag == string_constant) |
|
|
1185 return string; |
|
|
1186 else |
|
|
1187 { |
|
|
1188 gripe_invalid_conversion (type_as_string (), "string"); |
|
|
1189 return 0; |
|
|
1190 } |
|
631
|
1191 } |
|
|
1192 |
|
|
1193 Range |
|
|
1194 TC_REP::range_value (void) const |
|
|
1195 { |
|
|
1196 assert (type_tag == range_constant); |
|
|
1197 return *range; |
|
|
1198 } |
|
|
1199 |
|
|
1200 // This could be made more efficient by doing all the work here rather |
|
|
1201 // than relying on matrix_value() to do any possible type conversions. |
|
|
1202 |
|
|
1203 ColumnVector |
|
|
1204 TC_REP::vector_value (int force_string_conversion, |
|
|
1205 int force_vector_conversion) const |
|
|
1206 { |
|
|
1207 ColumnVector retval; |
|
|
1208 |
|
|
1209 Matrix m = matrix_value (force_string_conversion); |
|
|
1210 |
|
|
1211 if (error_state) |
|
|
1212 return retval; |
|
|
1213 |
|
|
1214 int nr = m.rows (); |
|
|
1215 int nc = m.columns (); |
|
|
1216 if (nr == 1) |
|
|
1217 { |
|
|
1218 retval.resize (nc); |
|
|
1219 for (int i = 0; i < nc; i++) |
|
|
1220 retval.elem (i) = m (0, i); |
|
|
1221 } |
|
|
1222 else if (nc == 1) |
|
|
1223 { |
|
|
1224 retval.resize (nr); |
|
|
1225 for (int i = 0; i < nr; i++) |
|
|
1226 retval.elem (i) = m.elem (i, 0); |
|
|
1227 } |
|
|
1228 else if (nr > 0 && nc > 0 |
|
|
1229 && (user_pref.do_fortran_indexing || force_vector_conversion)) |
|
|
1230 { |
|
|
1231 retval.resize (nr * nc); |
|
|
1232 int k = 0; |
|
|
1233 for (int j = 0; j < nc; j++) |
|
|
1234 for (int i = 0; i < nr; i++) |
|
|
1235 retval.elem (k++) = m.elem (i, j); |
|
|
1236 } |
|
|
1237 else |
|
|
1238 gripe_invalid_conversion ("real matrix", "real vector"); |
|
|
1239 |
|
|
1240 return retval; |
|
|
1241 } |
|
|
1242 |
|
|
1243 // This could be made more efficient by doing all the work here rather |
|
|
1244 // than relying on complex_matrix_value() to do any possible type |
|
|
1245 // conversions. |
|
|
1246 |
|
|
1247 ComplexColumnVector |
|
|
1248 TC_REP::complex_vector_value (int force_string_conversion, |
|
|
1249 int force_vector_conversion) const |
|
|
1250 { |
|
|
1251 ComplexColumnVector retval; |
|
|
1252 |
|
|
1253 ComplexMatrix m = complex_matrix_value (force_string_conversion); |
|
|
1254 |
|
|
1255 if (error_state) |
|
|
1256 return retval; |
|
|
1257 |
|
|
1258 int nr = m.rows (); |
|
|
1259 int nc = m.columns (); |
|
|
1260 if (nr == 1) |
|
|
1261 { |
|
|
1262 retval.resize (nc); |
|
|
1263 for (int i = 0; i < nc; i++) |
|
|
1264 retval.elem (i) = m (0, i); |
|
|
1265 } |
|
|
1266 else if (nc == 1) |
|
|
1267 { |
|
|
1268 retval.resize (nr); |
|
|
1269 for (int i = 0; i < nr; i++) |
|
|
1270 retval.elem (i) = m.elem (i, 0); |
|
|
1271 } |
|
|
1272 else if (nr > 0 && nc > 0 |
|
|
1273 && (user_pref.do_fortran_indexing || force_vector_conversion)) |
|
|
1274 { |
|
|
1275 retval.resize (nr * nc); |
|
|
1276 int k = 0; |
|
|
1277 for (int j = 0; j < nc; j++) |
|
|
1278 for (int i = 0; i < nr; i++) |
|
|
1279 retval.elem (k++) = m.elem (i, j); |
|
|
1280 } |
|
|
1281 else |
|
|
1282 gripe_invalid_conversion ("complex matrix", "complex vector"); |
|
|
1283 |
|
492
|
1284 return retval; |
|
|
1285 } |
|
|
1286 |
|
|
1287 tree_constant |
|
631
|
1288 TC_REP::convert_to_str (void) |
|
492
|
1289 { |
|
|
1290 tree_constant retval; |
|
|
1291 |
|
|
1292 switch (type_tag) |
|
|
1293 { |
|
|
1294 case complex_scalar_constant: |
|
|
1295 case scalar_constant: |
|
|
1296 { |
|
|
1297 double d = double_value (); |
|
|
1298 int i = NINT (d); |
|
|
1299 // Warn about out of range conversions? |
|
|
1300 char s[2]; |
|
|
1301 s[0] = (char) i; |
|
|
1302 s[1] = '\0'; |
|
|
1303 retval = tree_constant (s); |
|
|
1304 } |
|
|
1305 break; |
|
631
|
1306 |
|
492
|
1307 case complex_matrix_constant: |
|
|
1308 case matrix_constant: |
|
|
1309 { |
|
631
|
1310 ColumnVector v = vector_value (); |
|
492
|
1311 int len = v.length (); |
|
|
1312 if (len == 0) |
|
|
1313 ::error ("can only convert vectors and scalars to strings"); |
|
|
1314 else |
|
|
1315 { |
|
|
1316 char *s = new char [len+1]; |
|
|
1317 s[len] = '\0'; |
|
|
1318 for (int i = 0; i < len; i++) |
|
|
1319 { |
|
|
1320 double d = v.elem (i); |
|
|
1321 int ival = NINT (d); |
|
|
1322 // Warn about out of range conversions? |
|
|
1323 s[i] = (char) ival; |
|
|
1324 } |
|
|
1325 retval = tree_constant (s); |
|
|
1326 delete [] s; |
|
|
1327 } |
|
|
1328 } |
|
|
1329 break; |
|
631
|
1330 |
|
492
|
1331 case range_constant: |
|
|
1332 { |
|
|
1333 Range r = range_value (); |
|
|
1334 double b = r.base (); |
|
|
1335 double incr = r.inc (); |
|
|
1336 int nel = r.nelem (); |
|
|
1337 char *s = new char [nel+1]; |
|
|
1338 s[nel] = '\0'; |
|
|
1339 for (int i = 0; i < nel; i++) |
|
|
1340 { |
|
|
1341 double d = b + i * incr; |
|
|
1342 int ival = NINT (d); |
|
|
1343 // Warn about out of range conversions? |
|
|
1344 s[i] = (char) ival; |
|
|
1345 } |
|
|
1346 retval = tree_constant (s); |
|
|
1347 delete [] s; |
|
|
1348 } |
|
|
1349 break; |
|
631
|
1350 |
|
492
|
1351 case string_constant: |
|
581
|
1352 retval = string; |
|
492
|
1353 break; |
|
631
|
1354 |
|
492
|
1355 case magic_colon: |
|
|
1356 default: |
|
|
1357 panic_impossible (); |
|
|
1358 break; |
|
|
1359 } |
|
631
|
1360 |
|
492
|
1361 return retval; |
|
|
1362 } |
|
|
1363 |
|
|
1364 void |
|
631
|
1365 TC_REP::convert_to_row_or_column_vector (void) |
|
492
|
1366 { |
|
|
1367 assert (type_tag == matrix_constant || type_tag == complex_matrix_constant); |
|
|
1368 |
|
|
1369 int nr = rows (); |
|
|
1370 int nc = columns (); |
|
|
1371 |
|
509
|
1372 if (nr == 1 || nc == 1) |
|
|
1373 return; |
|
|
1374 |
|
492
|
1375 int len = nr * nc; |
|
|
1376 |
|
|
1377 assert (len > 0); |
|
|
1378 |
|
|
1379 int new_nr = 1; |
|
|
1380 int new_nc = 1; |
|
|
1381 |
|
|
1382 if (user_pref.prefer_column_vectors) |
|
|
1383 new_nr = len; |
|
|
1384 else |
|
|
1385 new_nc = len; |
|
|
1386 |
|
|
1387 if (type_tag == matrix_constant) |
|
|
1388 { |
|
|
1389 Matrix *m = new Matrix (new_nr, new_nc); |
|
|
1390 |
|
|
1391 double *cop_out = matrix->fortran_vec (); |
|
|
1392 |
|
|
1393 for (int i = 0; i < len; i++) |
|
|
1394 { |
|
|
1395 if (new_nr == 1) |
|
|
1396 m->elem (0, i) = *cop_out++; |
|
|
1397 else |
|
|
1398 m->elem (i, 0) = *cop_out++; |
|
|
1399 } |
|
|
1400 |
|
|
1401 delete matrix; |
|
|
1402 matrix = m; |
|
|
1403 } |
|
|
1404 else |
|
|
1405 { |
|
|
1406 ComplexMatrix *cm = new ComplexMatrix (new_nr, new_nc); |
|
|
1407 |
|
|
1408 Complex *cop_out = complex_matrix->fortran_vec (); |
|
|
1409 |
|
|
1410 for (int i = 0; i < len; i++) |
|
|
1411 { |
|
|
1412 if (new_nr == 1) |
|
|
1413 cm->elem (0, i) = *cop_out++; |
|
|
1414 else |
|
|
1415 cm->elem (i, 0) = *cop_out++; |
|
|
1416 } |
|
|
1417 |
|
|
1418 delete complex_matrix; |
|
|
1419 complex_matrix = cm; |
|
|
1420 } |
|
|
1421 } |
|
|
1422 |
|
631
|
1423 void |
|
|
1424 TC_REP::force_numeric (int force_str_conv) |
|
492
|
1425 { |
|
|
1426 switch (type_tag) |
|
|
1427 { |
|
|
1428 case scalar_constant: |
|
|
1429 case matrix_constant: |
|
|
1430 case complex_scalar_constant: |
|
|
1431 case complex_matrix_constant: |
|
631
|
1432 break; |
|
|
1433 |
|
|
1434 case string_constant: |
|
492
|
1435 { |
|
631
|
1436 if (! force_str_conv && ! user_pref.implicit_str_to_num_ok) |
|
|
1437 { |
|
|
1438 ::error ("failed to convert `%s' to a numeric type --", string); |
|
|
1439 ::error ("default conversion turned off"); |
|
|
1440 // Abort! |
|
|
1441 jump_to_top_level (); |
|
|
1442 } |
|
|
1443 |
|
|
1444 int len = strlen (string); |
|
|
1445 if (len > 1) |
|
|
1446 { |
|
|
1447 type_tag = matrix_constant; |
|
|
1448 Matrix *tm = new Matrix (1, len); |
|
|
1449 for (int i = 0; i < len; i++) |
|
|
1450 tm->elem (0, i) = toascii ((int) string[i]); |
|
|
1451 matrix = tm; |
|
|
1452 } |
|
|
1453 else if (len == 1) |
|
|
1454 { |
|
|
1455 type_tag = scalar_constant; |
|
|
1456 scalar = toascii ((int) string[0]); |
|
|
1457 } |
|
|
1458 else if (len == 0) |
|
|
1459 { |
|
|
1460 type_tag = matrix_constant; |
|
|
1461 matrix = new Matrix (0, 0); |
|
|
1462 } |
|
|
1463 else |
|
|
1464 panic_impossible (); |
|
492
|
1465 } |
|
|
1466 break; |
|
631
|
1467 |
|
492
|
1468 case range_constant: |
|
631
|
1469 { |
|
|
1470 int len = range->nelem (); |
|
|
1471 if (len > 1) |
|
|
1472 { |
|
|
1473 type_tag = matrix_constant; |
|
|
1474 Matrix *tm = new Matrix (1, len); |
|
|
1475 double b = range->base (); |
|
|
1476 double increment = range->inc (); |
|
|
1477 for (int i = 0; i < len; i++) |
|
|
1478 tm->elem (0, i) = b + i * increment; |
|
|
1479 matrix = tm; |
|
|
1480 } |
|
|
1481 else if (len == 1) |
|
|
1482 { |
|
|
1483 type_tag = scalar_constant; |
|
|
1484 scalar = range->base (); |
|
|
1485 } |
|
|
1486 } |
|
|
1487 break; |
|
|
1488 |
|
492
|
1489 case magic_colon: |
|
|
1490 default: |
|
|
1491 panic_impossible (); |
|
|
1492 break; |
|
|
1493 } |
|
|
1494 } |
|
|
1495 |
|
|
1496 tree_constant |
|
631
|
1497 TC_REP::make_numeric (int force_str_conv) const |
|
492
|
1498 { |
|
|
1499 tree_constant retval; |
|
631
|
1500 |
|
492
|
1501 switch (type_tag) |
|
|
1502 { |
|
|
1503 case scalar_constant: |
|
|
1504 retval = tree_constant (scalar); |
|
|
1505 break; |
|
631
|
1506 |
|
492
|
1507 case matrix_constant: |
|
631
|
1508 retval = tree_constant (*matrix); |
|
|
1509 break; |
|
|
1510 |
|
492
|
1511 case complex_scalar_constant: |
|
|
1512 retval = tree_constant (*complex_scalar); |
|
|
1513 break; |
|
631
|
1514 |
|
492
|
1515 case complex_matrix_constant: |
|
631
|
1516 retval = tree_constant (*complex_matrix); |
|
|
1517 break; |
|
|
1518 |
|
492
|
1519 case string_constant: |
|
631
|
1520 retval = tree_constant (string); |
|
|
1521 retval.force_numeric (force_str_conv); |
|
|
1522 break; |
|
|
1523 |
|
492
|
1524 case range_constant: |
|
631
|
1525 retval = tree_constant (*range); |
|
|
1526 retval.force_numeric (force_str_conv); |
|
|
1527 break; |
|
|
1528 |
|
492
|
1529 case magic_colon: |
|
|
1530 default: |
|
|
1531 panic_impossible (); |
|
|
1532 break; |
|
|
1533 } |
|
631
|
1534 |
|
|
1535 return retval; |
|
|
1536 } |
|
|
1537 |
|
|
1538 void |
|
|
1539 TC_REP::bump_value (tree_expression::type etype) |
|
|
1540 { |
|
|
1541 switch (etype) |
|
|
1542 { |
|
|
1543 case tree_expression::increment: |
|
|
1544 switch (type_tag) |
|
|
1545 { |
|
|
1546 case scalar_constant: |
|
|
1547 scalar++; |
|
|
1548 break; |
|
|
1549 |
|
|
1550 case matrix_constant: |
|
|
1551 *matrix = *matrix + 1.0; |
|
|
1552 break; |
|
|
1553 |
|
|
1554 case complex_scalar_constant: |
|
|
1555 *complex_scalar = *complex_scalar + 1.0; |
|
|
1556 break; |
|
|
1557 |
|
|
1558 case complex_matrix_constant: |
|
|
1559 *complex_matrix = *complex_matrix + 1.0; |
|
|
1560 break; |
|
|
1561 |
|
|
1562 case string_constant: |
|
|
1563 ::error ("string++ and ++string not implemented yet, ok?"); |
|
|
1564 break; |
|
|
1565 |
|
|
1566 case range_constant: |
|
|
1567 range->set_base (range->base () + 1.0); |
|
|
1568 range->set_limit (range->limit () + 1.0); |
|
|
1569 break; |
|
|
1570 |
|
|
1571 case magic_colon: |
|
|
1572 default: |
|
|
1573 panic_impossible (); |
|
|
1574 break; |
|
|
1575 } |
|
|
1576 break; |
|
|
1577 |
|
|
1578 case tree_expression::decrement: |
|
|
1579 switch (type_tag) |
|
|
1580 { |
|
|
1581 case scalar_constant: |
|
|
1582 scalar--; |
|
|
1583 break; |
|
|
1584 |
|
|
1585 case matrix_constant: |
|
|
1586 *matrix = *matrix - 1.0; |
|
|
1587 break; |
|
|
1588 |
|
|
1589 case string_constant: |
|
|
1590 ::error ("string-- and -- string not implemented yet, ok?"); |
|
|
1591 break; |
|
|
1592 |
|
|
1593 case range_constant: |
|
|
1594 range->set_base (range->base () - 1.0); |
|
|
1595 range->set_limit (range->limit () - 1.0); |
|
|
1596 break; |
|
|
1597 |
|
|
1598 case magic_colon: |
|
|
1599 default: |
|
|
1600 panic_impossible (); |
|
|
1601 break; |
|
|
1602 } |
|
|
1603 break; |
|
|
1604 |
|
|
1605 default: |
|
|
1606 panic_impossible (); |
|
|
1607 break; |
|
|
1608 } |
|
|
1609 } |
|
|
1610 |
|
|
1611 void |
|
|
1612 TC_REP::resize (int i, int j) |
|
|
1613 { |
|
|
1614 switch (type_tag) |
|
|
1615 { |
|
|
1616 case matrix_constant: |
|
|
1617 matrix->resize (i, j); |
|
|
1618 break; |
|
|
1619 |
|
|
1620 case complex_matrix_constant: |
|
|
1621 complex_matrix->resize (i, j); |
|
|
1622 break; |
|
|
1623 |
|
|
1624 default: |
|
|
1625 panic_impossible (); |
|
|
1626 break; |
|
|
1627 } |
|
|
1628 } |
|
|
1629 |
|
|
1630 void |
|
|
1631 TC_REP::resize (int i, int j, double val) |
|
|
1632 { |
|
|
1633 switch (type_tag) |
|
|
1634 { |
|
|
1635 case matrix_constant: |
|
|
1636 matrix->resize (i, j, val); |
|
|
1637 break; |
|
|
1638 |
|
|
1639 case complex_matrix_constant: |
|
|
1640 complex_matrix->resize (i, j, val); |
|
|
1641 break; |
|
|
1642 |
|
|
1643 default: |
|
|
1644 panic_impossible (); |
|
|
1645 break; |
|
|
1646 } |
|
|
1647 } |
|
|
1648 |
|
|
1649 void |
|
|
1650 TC_REP::maybe_resize (int i, int j) |
|
|
1651 { |
|
|
1652 int nr = rows (); |
|
|
1653 int nc = columns (); |
|
|
1654 |
|
|
1655 i++; |
|
|
1656 j++; |
|
|
1657 |
|
|
1658 assert (i > 0 && j > 0); |
|
|
1659 |
|
|
1660 if (i > nr || j > nc) |
|
|
1661 { |
|
|
1662 if (user_pref.resize_on_range_error) |
|
|
1663 resize (MAX (i, nr), MAX (j, nc), 0.0); |
|
|
1664 else |
|
|
1665 { |
|
|
1666 if (i > nr) |
|
|
1667 ::error ("row index = %d exceeds max row dimension = %d", i, nr); |
|
|
1668 |
|
|
1669 if (j > nc) |
|
|
1670 ::error ("column index = %d exceeds max column dimension = %d", |
|
|
1671 j, nc); |
|
|
1672 } |
|
|
1673 } |
|
|
1674 } |
|
|
1675 |
|
|
1676 void |
|
|
1677 TC_REP::maybe_resize (int i, force_orient f_orient) |
|
|
1678 { |
|
|
1679 int nr = rows (); |
|
|
1680 int nc = columns (); |
|
|
1681 |
|
|
1682 i++; |
|
|
1683 |
|
|
1684 assert (i >= 0 && (nr <= 1 || nc <= 1)); |
|
|
1685 |
|
|
1686 // This function never reduces the size of a vector, and all vectors |
|
|
1687 // have dimensions of at least 0x0. If i is 0, it is either because |
|
|
1688 // a vector has been indexed with a vector of all zeros (in which case |
|
|
1689 // the index vector is empty and nothing will happen) or a vector has |
|
|
1690 // been indexed with 0 (an error which will be caught elsewhere). |
|
|
1691 if (i == 0) |
|
|
1692 return; |
|
|
1693 |
|
|
1694 if (nr <= 1 && nc <= 1 && i >= 1) |
|
|
1695 { |
|
|
1696 if (user_pref.resize_on_range_error) |
|
|
1697 { |
|
|
1698 if (f_orient == row_orient) |
|
|
1699 resize (1, i, 0.0); |
|
|
1700 else if (f_orient == column_orient) |
|
|
1701 resize (i, 1, 0.0); |
|
|
1702 else if (user_pref.prefer_column_vectors) |
|
|
1703 resize (i, 1, 0.0); |
|
|
1704 else |
|
|
1705 resize (1, i, 0.0); |
|
|
1706 } |
|
|
1707 else |
|
|
1708 ::error ("matrix index = %d exceeds max dimension = %d", i, nc); |
|
|
1709 } |
|
|
1710 else if (nr == 1 && i > nc) |
|
|
1711 { |
|
|
1712 if (user_pref.resize_on_range_error) |
|
|
1713 resize (1, i, 0.0); |
|
|
1714 else |
|
|
1715 ::error ("matrix index = %d exceeds max dimension = %d", i, nc); |
|
|
1716 } |
|
|
1717 else if (nc == 1 && i > nr) |
|
|
1718 { |
|
|
1719 if (user_pref.resize_on_range_error) |
|
|
1720 resize (i, 1, 0.0); |
|
|
1721 else |
|
|
1722 ::error ("matrix index = %d exceeds max dimension = ", i, nc); |
|
|
1723 } |
|
|
1724 } |
|
|
1725 |
|
|
1726 void |
|
|
1727 TC_REP::stash_original_text (char *s) |
|
|
1728 { |
|
|
1729 orig_text = strsave (s); |
|
|
1730 } |
|
|
1731 |
|
|
1732 // Indexing functions. |
|
|
1733 |
|
|
1734 tree_constant |
|
|
1735 TC_REP::do_index (const Octave_object& args) |
|
|
1736 { |
|
|
1737 tree_constant retval; |
|
|
1738 |
|
|
1739 if (error_state) |
|
|
1740 return retval; |
|
|
1741 |
|
|
1742 if (rows () == 0 || columns () == 0) |
|
|
1743 { |
|
|
1744 ::error ("attempt to index empty matrix"); |
|
|
1745 return retval; |
|
|
1746 } |
|
|
1747 |
|
|
1748 switch (type_tag) |
|
|
1749 { |
|
|
1750 case complex_scalar_constant: |
|
|
1751 case scalar_constant: |
|
|
1752 retval = do_scalar_index (args); |
|
|
1753 break; |
|
|
1754 |
|
|
1755 case complex_matrix_constant: |
|
|
1756 case matrix_constant: |
|
|
1757 retval = do_matrix_index (args); |
|
|
1758 break; |
|
|
1759 |
|
|
1760 case string_constant: |
|
|
1761 gripe_string_invalid (); |
|
|
1762 // retval = do_string_index (args); |
|
|
1763 break; |
|
|
1764 |
|
|
1765 case magic_colon: |
|
|
1766 case range_constant: |
|
|
1767 // This isn\'t great, but it\'s easier than implementing a lot of |
|
|
1768 // range indexing functions. |
|
|
1769 force_numeric (); |
|
|
1770 assert (type_tag != magic_colon && type_tag != range_constant); |
|
|
1771 retval = do_index (args); |
|
|
1772 break; |
|
|
1773 |
|
|
1774 default: |
|
|
1775 panic_impossible (); |
|
|
1776 break; |
|
|
1777 } |
|
|
1778 |
|
492
|
1779 return retval; |
|
|
1780 } |
|
|
1781 |
|
|
1782 tree_constant |
|
631
|
1783 TC_REP::do_scalar_index (const Octave_object& args) const |
|
492
|
1784 { |
|
|
1785 tree_constant retval; |
|
631
|
1786 |
|
|
1787 if (valid_scalar_indices (args)) |
|
|
1788 { |
|
|
1789 if (type_tag == scalar_constant) |
|
|
1790 retval = scalar; |
|
|
1791 else if (type_tag == complex_scalar_constant) |
|
|
1792 retval = *complex_scalar; |
|
|
1793 else |
|
|
1794 panic_impossible (); |
|
|
1795 |
|
|
1796 return retval; |
|
|
1797 } |
|
|
1798 else |
|
|
1799 { |
|
|
1800 int rows = 0; |
|
|
1801 int cols = 0; |
|
|
1802 |
|
|
1803 int nargin = args.length (); |
|
|
1804 |
|
|
1805 switch (nargin) |
|
|
1806 { |
|
|
1807 case 3: |
|
|
1808 { |
|
|
1809 if (args(2).is_matrix_type ()) |
|
|
1810 { |
|
|
1811 Matrix mj = args(2).matrix_value (); |
|
|
1812 |
|
|
1813 idx_vector j (mj, user_pref.do_fortran_indexing, ""); |
|
|
1814 if (! j) |
|
|
1815 return retval; |
|
|
1816 |
|
|
1817 int len = j.length (); |
|
|
1818 if (len == j.ones_count ()) |
|
|
1819 cols = len; |
|
|
1820 } |
|
|
1821 else if (args(2).const_type () == magic_colon |
|
|
1822 || (args(2).is_scalar_type () |
|
|
1823 && NINT (args(2).double_value ()) == 1)) |
|
|
1824 { |
|
|
1825 cols = 1; |
|
|
1826 } |
|
|
1827 else |
|
|
1828 break; |
|
|
1829 } |
|
|
1830 |
|
|
1831 // Fall through... |
|
|
1832 |
|
|
1833 case 2: |
|
|
1834 { |
|
|
1835 if (args(1).is_matrix_type ()) |
|
|
1836 { |
|
|
1837 Matrix mi = args(1).matrix_value (); |
|
|
1838 |
|
|
1839 idx_vector i (mi, user_pref.do_fortran_indexing, ""); |
|
|
1840 if (! i) |
|
|
1841 return retval; |
|
|
1842 |
|
|
1843 int len = i.length (); |
|
|
1844 if (len == i.ones_count ()) |
|
|
1845 rows = len; |
|
|
1846 } |
|
|
1847 else if (args(1).const_type () == magic_colon |
|
|
1848 || (args(1).is_scalar_type () |
|
|
1849 && NINT (args(1).double_value ()) == 1)) |
|
|
1850 { |
|
|
1851 rows = 1; |
|
|
1852 } |
|
|
1853 else if (args(1).is_scalar_type () |
|
|
1854 && NINT (args(1).double_value ()) == 0) |
|
|
1855 { |
|
|
1856 return Matrix (); |
|
|
1857 } |
|
|
1858 else |
|
|
1859 break; |
|
|
1860 |
|
|
1861 if (cols == 0) |
|
|
1862 { |
|
|
1863 if (user_pref.prefer_column_vectors) |
|
|
1864 cols = 1; |
|
|
1865 else |
|
|
1866 { |
|
|
1867 cols = rows; |
|
|
1868 rows = 1; |
|
|
1869 } |
|
|
1870 } |
|
|
1871 |
|
|
1872 if (type_tag == scalar_constant) |
|
|
1873 { |
|
|
1874 return Matrix (rows, cols, scalar); |
|
|
1875 } |
|
|
1876 else if (type_tag == complex_scalar_constant) |
|
|
1877 { |
|
|
1878 return ComplexMatrix (rows, cols, *complex_scalar); |
|
|
1879 } |
|
|
1880 else |
|
|
1881 panic_impossible (); |
|
|
1882 } |
|
|
1883 break; |
|
|
1884 |
|
|
1885 default: |
|
|
1886 ::error ("invalid number of arguments for scalar type"); |
|
|
1887 return tree_constant (); |
|
|
1888 break; |
|
|
1889 } |
|
|
1890 } |
|
|
1891 |
|
|
1892 ::error ("index invalid or out of range for scalar type"); |
|
|
1893 return tree_constant (); |
|
|
1894 } |
|
|
1895 |
|
|
1896 tree_constant |
|
|
1897 TC_REP::do_matrix_index (const Octave_object& args) const |
|
|
1898 { |
|
|
1899 tree_constant retval; |
|
|
1900 |
|
|
1901 int nargin = args.length (); |
|
|
1902 |
|
|
1903 switch (nargin) |
|
|
1904 { |
|
|
1905 case 2: |
|
|
1906 if (args.length () <= 0) |
|
|
1907 ::error ("matrix index is null"); |
|
|
1908 else if (args(1).is_undefined ()) |
|
|
1909 ::error ("matrix index is a null expression"); |
|
|
1910 else |
|
|
1911 retval = do_matrix_index (args(1)); |
|
|
1912 break; |
|
|
1913 |
|
|
1914 case 3: |
|
|
1915 if (args.length () <= 0) |
|
|
1916 ::error ("matrix indices are null"); |
|
|
1917 else if (args(1).is_undefined ()) |
|
|
1918 ::error ("first matrix index is a null expression"); |
|
|
1919 else if (args(2).is_undefined ()) |
|
|
1920 ::error ("second matrix index is a null expression"); |
|
|
1921 else |
|
|
1922 retval = do_matrix_index (args(1), args(2)); |
|
|
1923 break; |
|
|
1924 |
|
|
1925 default: |
|
|
1926 ::error ("too many indices for matrix expression"); |
|
|
1927 break; |
|
|
1928 } |
|
|
1929 |
|
|
1930 return retval; |
|
|
1931 } |
|
|
1932 |
|
|
1933 tree_constant |
|
|
1934 TC_REP::do_matrix_index (const tree_constant& i_arg) const |
|
|
1935 { |
|
|
1936 tree_constant retval; |
|
|
1937 |
|
|
1938 int nr = rows (); |
|
|
1939 int nc = columns (); |
|
|
1940 |
|
|
1941 if (user_pref.do_fortran_indexing) |
|
|
1942 retval = fortran_style_matrix_index (i_arg); |
|
|
1943 else if (nr <= 1 || nc <= 1) |
|
|
1944 retval = do_vector_index (i_arg); |
|
|
1945 else |
|
|
1946 ::error ("single index only valid for row or column vector"); |
|
|
1947 |
|
|
1948 return retval; |
|
|
1949 } |
|
|
1950 |
|
|
1951 tree_constant |
|
|
1952 TC_REP::do_matrix_index (const tree_constant& i_arg, |
|
|
1953 const tree_constant& j_arg) const |
|
|
1954 { |
|
|
1955 tree_constant retval; |
|
|
1956 |
|
|
1957 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
1958 |
|
|
1959 TC_REP::constant_type itype = tmp_i.const_type (); |
|
|
1960 |
|
|
1961 switch (itype) |
|
|
1962 { |
|
|
1963 case complex_scalar_constant: |
|
492
|
1964 case scalar_constant: |
|
631
|
1965 { |
|
|
1966 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
1967 if (index_check (i, "row") < 0) |
|
|
1968 return tree_constant (); |
|
|
1969 retval = do_matrix_index (i, j_arg); |
|
|
1970 } |
|
|
1971 break; |
|
|
1972 |
|
|
1973 case complex_matrix_constant: |
|
492
|
1974 case matrix_constant: |
|
|
1975 { |
|
631
|
1976 Matrix mi = tmp_i.matrix_value (); |
|
|
1977 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); |
|
|
1978 if (! iv) |
|
|
1979 return tree_constant (); |
|
|
1980 |
|
|
1981 if (iv.length () == 0) |
|
|
1982 { |
|
|
1983 Matrix mtmp; |
|
|
1984 retval = tree_constant (mtmp); |
|
|
1985 } |
|
|
1986 else |
|
|
1987 retval = do_matrix_index (iv, j_arg); |
|
492
|
1988 } |
|
|
1989 break; |
|
631
|
1990 |
|
|
1991 case string_constant: |
|
|
1992 gripe_string_invalid (); |
|
|
1993 break; |
|
|
1994 |
|
|
1995 case range_constant: |
|
492
|
1996 { |
|
631
|
1997 Range ri = tmp_i.range_value (); |
|
|
1998 int nr = rows (); |
|
|
1999 if (nr == 2 && is_zero_one (ri)) |
|
|
2000 { |
|
|
2001 retval = do_matrix_index (1, j_arg); |
|
|
2002 } |
|
|
2003 else if (nr == 2 && is_one_zero (ri)) |
|
|
2004 { |
|
|
2005 retval = do_matrix_index (0, j_arg); |
|
|
2006 } |
|
|
2007 else |
|
|
2008 { |
|
|
2009 if (index_check (ri, "row") < 0) |
|
|
2010 return tree_constant (); |
|
|
2011 retval = do_matrix_index (ri, j_arg); |
|
|
2012 } |
|
492
|
2013 } |
|
|
2014 break; |
|
631
|
2015 |
|
492
|
2016 case magic_colon: |
|
631
|
2017 retval = do_matrix_index (magic_colon, j_arg); |
|
|
2018 break; |
|
|
2019 |
|
492
|
2020 default: |
|
|
2021 panic_impossible (); |
|
|
2022 break; |
|
|
2023 } |
|
631
|
2024 |
|
|
2025 return retval; |
|
|
2026 } |
|
|
2027 |
|
|
2028 tree_constant |
|
|
2029 TC_REP::do_matrix_index (TC_REP::constant_type mci) const |
|
|
2030 { |
|
|
2031 assert (mci == magic_colon); |
|
|
2032 |
|
|
2033 tree_constant retval; |
|
|
2034 int nr = rows (); |
|
|
2035 int nc = columns (); |
|
|
2036 int size = nr * nc; |
|
|
2037 if (size > 0) |
|
|
2038 { |
|
|
2039 CRMATRIX (m, cm, size, 1); |
|
|
2040 int idx = 0; |
|
|
2041 for (int j = 0; j < nc; j++) |
|
|
2042 for (int i = 0; i < nr; i++) |
|
|
2043 { |
|
|
2044 CRMATRIX_ASSIGN_REP_ELEM (m, cm, idx, 0, i, j); |
|
|
2045 idx++; |
|
|
2046 } |
|
|
2047 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2048 } |
|
492
|
2049 return retval; |
|
|
2050 } |
|
|
2051 |
|
|
2052 tree_constant |
|
631
|
2053 TC_REP::fortran_style_matrix_index (const tree_constant& i_arg) const |
|
492
|
2054 { |
|
|
2055 tree_constant retval; |
|
631
|
2056 |
|
|
2057 tree_constant tmp_i = i_arg.make_numeric_or_magic (); |
|
|
2058 |
|
|
2059 TC_REP::constant_type itype = tmp_i.const_type (); |
|
|
2060 |
|
|
2061 int nr = rows (); |
|
|
2062 int nc = columns (); |
|
|
2063 |
|
|
2064 switch (itype) |
|
|
2065 { |
|
|
2066 case complex_scalar_constant: |
|
492
|
2067 case scalar_constant: |
|
631
|
2068 { |
|
|
2069 int i = NINT (tmp_i.double_value ()); |
|
|
2070 int ii = fortran_row (i, nr) - 1; |
|
|
2071 int jj = fortran_column (i, nr) - 1; |
|
|
2072 if (index_check (i-1, "") < 0) |
|
|
2073 return tree_constant (); |
|
|
2074 if (range_max_check (i-1, nr * nc) < 0) |
|
|
2075 return tree_constant (); |
|
|
2076 retval = do_matrix_index (ii, jj); |
|
|
2077 } |
|
|
2078 break; |
|
|
2079 |
|
|
2080 case complex_matrix_constant: |
|
492
|
2081 case matrix_constant: |
|
|
2082 { |
|
631
|
2083 Matrix mi = tmp_i.matrix_value (); |
|
|
2084 if (mi.rows () == 0 || mi.columns () == 0) |
|
|
2085 { |
|
|
2086 Matrix mtmp; |
|
|
2087 retval = tree_constant (mtmp); |
|
|
2088 } |
|
|
2089 else |
|
|
2090 { |
|
|
2091 // Yes, we really do want to call this with mi. |
|
|
2092 retval = fortran_style_matrix_index (mi); |
|
|
2093 } |
|
492
|
2094 } |
|
|
2095 break; |
|
631
|
2096 |
|
492
|
2097 case string_constant: |
|
631
|
2098 gripe_string_invalid (); |
|
|
2099 break; |
|
|
2100 |
|
492
|
2101 case range_constant: |
|
631
|
2102 gripe_range_invalid (); |
|
|
2103 break; |
|
|
2104 |
|
492
|
2105 case magic_colon: |
|
631
|
2106 retval = do_matrix_index (magic_colon); |
|
|
2107 break; |
|
|
2108 |
|
492
|
2109 default: |
|
|
2110 panic_impossible (); |
|
|
2111 break; |
|
|
2112 } |
|
631
|
2113 |
|
492
|
2114 return retval; |
|
|
2115 } |
|
|
2116 |
|
|
2117 tree_constant |
|
631
|
2118 TC_REP::fortran_style_matrix_index (const Matrix& mi) const |
|
492
|
2119 { |
|
631
|
2120 assert (is_matrix_type ()); |
|
492
|
2121 |
|
|
2122 tree_constant retval; |
|
|
2123 |
|
631
|
2124 int nr = rows (); |
|
|
2125 int nc = columns (); |
|
|
2126 |
|
|
2127 int len = nr * nc; |
|
|
2128 |
|
|
2129 int index_nr = mi.rows (); |
|
|
2130 int index_nc = mi.columns (); |
|
|
2131 |
|
|
2132 if (index_nr >= 1 && index_nc >= 1) |
|
|
2133 { |
|
|
2134 const double *cop_out = 0; |
|
|
2135 const Complex *c_cop_out = 0; |
|
|
2136 int real_type = type_tag == matrix_constant; |
|
|
2137 if (real_type) |
|
|
2138 cop_out = matrix->data (); |
|
|
2139 else |
|
|
2140 c_cop_out = complex_matrix->data (); |
|
|
2141 |
|
|
2142 const double *cop_out_index = mi.data (); |
|
|
2143 |
|
|
2144 idx_vector iv (mi, 1, "", len); |
|
|
2145 if (! iv) |
|
|
2146 return tree_constant (); |
|
|
2147 |
|
|
2148 int result_size = iv.length (); |
|
|
2149 |
|
|
2150 if (nc == 1 || (nr != 1 && iv.one_zero_only ())) |
|
|
2151 { |
|
|
2152 CRMATRIX (m, cm, result_size, 1); |
|
|
2153 |
|
|
2154 for (int i = 0; i < result_size; i++) |
|
|
2155 { |
|
|
2156 int idx = iv.elem (i); |
|
|
2157 CRMATRIX_ASSIGN_ELEM (m, cm, i, 0, cop_out [idx], |
|
|
2158 c_cop_out [idx], real_type); |
|
|
2159 } |
|
|
2160 |
|
|
2161 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2162 } |
|
|
2163 else if (nr == 1) |
|
|
2164 { |
|
|
2165 CRMATRIX (m, cm, 1, result_size); |
|
|
2166 |
|
|
2167 for (int i = 0; i < result_size; i++) |
|
|
2168 { |
|
|
2169 int idx = iv.elem (i); |
|
|
2170 CRMATRIX_ASSIGN_ELEM (m, cm, 0, i, cop_out [idx], |
|
|
2171 c_cop_out [idx], real_type); |
|
|
2172 } |
|
|
2173 |
|
|
2174 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2175 } |
|
|
2176 else |
|
|
2177 { |
|
|
2178 CRMATRIX (m, cm, index_nr, index_nc); |
|
|
2179 |
|
|
2180 for (int j = 0; j < index_nc; j++) |
|
|
2181 for (int i = 0; i < index_nr; i++) |
|
|
2182 { |
|
|
2183 double tmp = *cop_out_index++; |
|
|
2184 int idx = tree_to_mat_idx (tmp); |
|
|
2185 CRMATRIX_ASSIGN_ELEM (m, cm, i, j, cop_out [idx], |
|
|
2186 c_cop_out [idx], real_type); |
|
|
2187 } |
|
|
2188 |
|
|
2189 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2190 } |
|
492
|
2191 } |
|
|
2192 else |
|
|
2193 { |
|
631
|
2194 if (index_nr == 0 || index_nc == 0) |
|
|
2195 ::error ("empty matrix invalid as index"); |
|
|
2196 else |
|
|
2197 ::error ("invalid matrix index"); |
|
|
2198 return tree_constant (); |
|
492
|
2199 } |
|
|
2200 |
|
|
2201 return retval; |
|
|
2202 } |
|
|
2203 |
|
|
2204 tree_constant |
|
631
|
2205 TC_REP::do_vector_index (const tree_constant& i_arg) const |
|
492
|
2206 { |
|
|
2207 tree_constant retval; |
|
631
|
2208 |
|
|
2209 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
2210 |
|
|
2211 TC_REP::constant_type itype = tmp_i.const_type (); |
|
|
2212 |
|
|
2213 int nr = rows (); |
|
|
2214 int nc = columns (); |
|
|
2215 |
|
|
2216 int len = MAX (nr, nc); |
|
|
2217 |
|
|
2218 assert ((nr == 1 || nc == 1) && ! user_pref.do_fortran_indexing); |
|
|
2219 |
|
|
2220 int swap_indices = (nr == 1); |
|
|
2221 |
|
|
2222 switch (itype) |
|
|
2223 { |
|
|
2224 case complex_scalar_constant: |
|
492
|
2225 case scalar_constant: |
|
631
|
2226 { |
|
|
2227 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
2228 if (index_check (i, "") < 0) |
|
|
2229 return tree_constant (); |
|
|
2230 if (swap_indices) |
|
|
2231 { |
|
|
2232 if (range_max_check (i, nc) < 0) |
|
|
2233 return tree_constant (); |
|
|
2234 retval = do_matrix_index (0, i); |
|
|
2235 } |
|
|
2236 else |
|
|
2237 { |
|
|
2238 if (range_max_check (i, nr) < 0) |
|
|
2239 return tree_constant (); |
|
|
2240 retval = do_matrix_index (i, 0); |
|
|
2241 } |
|
|
2242 } |
|
|
2243 break; |
|
|
2244 |
|
|
2245 case complex_matrix_constant: |
|
492
|
2246 case matrix_constant: |
|
|
2247 { |
|
631
|
2248 Matrix mi = tmp_i.matrix_value (); |
|
|
2249 if (mi.rows () == 0 || mi.columns () == 0) |
|
|
2250 { |
|
|
2251 Matrix mtmp; |
|
|
2252 retval = tree_constant (mtmp); |
|
|
2253 } |
|
|
2254 else |
|
|
2255 { |
|
|
2256 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); |
|
|
2257 if (! iv) |
|
|
2258 return tree_constant (); |
|
|
2259 |
|
|
2260 if (swap_indices) |
|
|
2261 { |
|
|
2262 if (range_max_check (iv.max (), nc) < 0) |
|
|
2263 return tree_constant (); |
|
|
2264 retval = do_matrix_index (0, iv); |
|
|
2265 } |
|
|
2266 else |
|
|
2267 { |
|
|
2268 if (range_max_check (iv.max (), nr) < 0) |
|
|
2269 return tree_constant (); |
|
|
2270 retval = do_matrix_index (iv, 0); |
|
|
2271 } |
|
|
2272 } |
|
|
2273 } |
|
|
2274 break; |
|
|
2275 |
|
|
2276 case string_constant: |
|
|
2277 gripe_string_invalid (); |
|
|
2278 break; |
|
|
2279 |
|
|
2280 case range_constant: |
|
|
2281 { |
|
|
2282 Range ri = tmp_i.range_value (); |
|
|
2283 if (len == 2 && is_zero_one (ri)) |
|
|
2284 { |
|
|
2285 if (swap_indices) |
|
|
2286 retval = do_matrix_index (0, 1); |
|
|
2287 else |
|
|
2288 retval = do_matrix_index (1, 0); |
|
|
2289 } |
|
|
2290 else if (len == 2 && is_one_zero (ri)) |
|
|
2291 { |
|
|
2292 retval = do_matrix_index (0, 0); |
|
|
2293 } |
|
|
2294 else |
|
|
2295 { |
|
|
2296 if (index_check (ri, "") < 0) |
|
|
2297 return tree_constant (); |
|
|
2298 if (swap_indices) |
|
|
2299 { |
|
|
2300 if (range_max_check (tree_to_mat_idx (ri.max ()), nc) < 0) |
|
|
2301 return tree_constant (); |
|
|
2302 retval = do_matrix_index (0, ri); |
|
|
2303 } |
|
|
2304 else |
|
|
2305 { |
|
|
2306 if (range_max_check (tree_to_mat_idx (ri.max ()), nr) < 0) |
|
|
2307 return tree_constant (); |
|
|
2308 retval = do_matrix_index (ri, 0); |
|
|
2309 } |
|
|
2310 } |
|
|
2311 } |
|
|
2312 break; |
|
|
2313 |
|
|
2314 case magic_colon: |
|
|
2315 if (swap_indices) |
|
|
2316 retval = do_matrix_index (0, magic_colon); |
|
|
2317 else |
|
|
2318 retval = do_matrix_index (magic_colon, 0); |
|
|
2319 break; |
|
|
2320 |
|
|
2321 default: |
|
|
2322 panic_impossible (); |
|
|
2323 break; |
|
|
2324 } |
|
|
2325 |
|
|
2326 return retval; |
|
|
2327 } |
|
|
2328 |
|
|
2329 tree_constant |
|
|
2330 TC_REP::do_matrix_index (int i, const tree_constant& j_arg) const |
|
|
2331 { |
|
|
2332 tree_constant retval; |
|
|
2333 |
|
|
2334 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
2335 |
|
|
2336 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
|
2337 |
|
|
2338 int nr = rows (); |
|
|
2339 int nc = columns (); |
|
|
2340 |
|
|
2341 switch (jtype) |
|
|
2342 { |
|
|
2343 case complex_scalar_constant: |
|
|
2344 case scalar_constant: |
|
|
2345 { |
|
|
2346 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
2347 if (index_check (j, "column") < 0) |
|
|
2348 return tree_constant (); |
|
|
2349 if (range_max_check (i, j, nr, nc) < 0) |
|
|
2350 return tree_constant (); |
|
|
2351 retval = do_matrix_index (i, j); |
|
|
2352 } |
|
|
2353 break; |
|
|
2354 |
|
|
2355 case complex_matrix_constant: |
|
|
2356 case matrix_constant: |
|
|
2357 { |
|
|
2358 Matrix mj = tmp_j.matrix_value (); |
|
|
2359 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
2360 if (! jv) |
|
|
2361 return tree_constant (); |
|
|
2362 |
|
|
2363 if (jv.length () == 0) |
|
492
|
2364 { |
|
|
2365 Matrix mtmp; |
|
|
2366 retval = tree_constant (mtmp); |
|
|
2367 } |
|
|
2368 else |
|
|
2369 { |
|
631
|
2370 if (range_max_check (i, jv.max (), nr, nc) < 0) |
|
|
2371 return tree_constant (); |
|
|
2372 retval = do_matrix_index (i, jv); |
|
|
2373 } |
|
|
2374 } |
|
|
2375 break; |
|
|
2376 |
|
|
2377 case string_constant: |
|
|
2378 gripe_string_invalid (); |
|
|
2379 break; |
|
|
2380 |
|
|
2381 case range_constant: |
|
|
2382 { |
|
|
2383 Range rj = tmp_j.range_value (); |
|
|
2384 if (nc == 2 && is_zero_one (rj)) |
|
|
2385 { |
|
|
2386 retval = do_matrix_index (i, 1); |
|
|
2387 } |
|
|
2388 else if (nc == 2 && is_one_zero (rj)) |
|
|
2389 { |
|
|
2390 retval = do_matrix_index (i, 0); |
|
|
2391 } |
|
|
2392 else |
|
|
2393 { |
|
|
2394 if (index_check (rj, "column") < 0) |
|
|
2395 return tree_constant (); |
|
|
2396 if (range_max_check (i, tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
2397 return tree_constant (); |
|
|
2398 retval = do_matrix_index (i, rj); |
|
492
|
2399 } |
|
|
2400 } |
|
|
2401 break; |
|
631
|
2402 |
|
|
2403 case magic_colon: |
|
|
2404 if (range_max_check (i, 0, nr, nc) < 0) |
|
|
2405 return tree_constant (); |
|
|
2406 retval = do_matrix_index (i, magic_colon); |
|
|
2407 break; |
|
|
2408 |
|
|
2409 default: |
|
|
2410 panic_impossible (); |
|
|
2411 break; |
|
|
2412 } |
|
|
2413 |
|
|
2414 return retval; |
|
|
2415 } |
|
|
2416 |
|
|
2417 tree_constant |
|
|
2418 TC_REP::do_matrix_index (const idx_vector& iv, |
|
|
2419 const tree_constant& j_arg) const |
|
|
2420 { |
|
|
2421 tree_constant retval; |
|
|
2422 |
|
|
2423 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
2424 |
|
|
2425 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
|
2426 |
|
|
2427 int nr = rows (); |
|
|
2428 int nc = columns (); |
|
|
2429 |
|
|
2430 switch (jtype) |
|
|
2431 { |
|
492
|
2432 case complex_scalar_constant: |
|
631
|
2433 case scalar_constant: |
|
|
2434 { |
|
|
2435 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
2436 if (index_check (j, "column") < 0) |
|
|
2437 return tree_constant (); |
|
|
2438 if (range_max_check (iv.max (), j, nr, nc) < 0) |
|
|
2439 return tree_constant (); |
|
|
2440 retval = do_matrix_index (iv, j); |
|
|
2441 } |
|
|
2442 break; |
|
|
2443 |
|
492
|
2444 case complex_matrix_constant: |
|
631
|
2445 case matrix_constant: |
|
492
|
2446 { |
|
631
|
2447 Matrix mj = tmp_j.matrix_value (); |
|
|
2448 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
2449 if (! jv) |
|
|
2450 return tree_constant (); |
|
|
2451 |
|
|
2452 if (jv.length () == 0) |
|
492
|
2453 { |
|
|
2454 Matrix mtmp; |
|
|
2455 retval = tree_constant (mtmp); |
|
|
2456 } |
|
|
2457 else |
|
|
2458 { |
|
631
|
2459 if (range_max_check (iv.max (), jv.max (), nr, nc) < 0) |
|
|
2460 return tree_constant (); |
|
|
2461 retval = do_matrix_index (iv, jv); |
|
|
2462 } |
|
|
2463 } |
|
|
2464 break; |
|
|
2465 |
|
|
2466 case string_constant: |
|
|
2467 gripe_string_invalid (); |
|
|
2468 break; |
|
|
2469 |
|
|
2470 case range_constant: |
|
|
2471 { |
|
|
2472 Range rj = tmp_j.range_value (); |
|
|
2473 if (nc == 2 && is_zero_one (rj)) |
|
|
2474 { |
|
|
2475 retval = do_matrix_index (iv, 1); |
|
|
2476 } |
|
|
2477 else if (nc == 2 && is_one_zero (rj)) |
|
|
2478 { |
|
|
2479 retval = do_matrix_index (iv, 0); |
|
|
2480 } |
|
|
2481 else |
|
|
2482 { |
|
|
2483 if (index_check (rj, "column") < 0) |
|
|
2484 return tree_constant (); |
|
|
2485 if (range_max_check (iv.max (), tree_to_mat_idx (rj.max ()), |
|
|
2486 nr, nc) < 0) |
|
|
2487 return tree_constant (); |
|
|
2488 retval = do_matrix_index (iv, rj); |
|
492
|
2489 } |
|
|
2490 } |
|
|
2491 break; |
|
631
|
2492 |
|
492
|
2493 case magic_colon: |
|
631
|
2494 if (range_max_check (iv.max (), 0, nr, nc) < 0) |
|
|
2495 return tree_constant (); |
|
|
2496 retval = do_matrix_index (iv, magic_colon); |
|
|
2497 break; |
|
|
2498 |
|
492
|
2499 default: |
|
|
2500 panic_impossible (); |
|
|
2501 break; |
|
|
2502 } |
|
631
|
2503 |
|
|
2504 return retval; |
|
|
2505 } |
|
|
2506 |
|
|
2507 tree_constant |
|
|
2508 TC_REP::do_matrix_index (const Range& ri, |
|
|
2509 const tree_constant& j_arg) const |
|
|
2510 { |
|
|
2511 tree_constant retval; |
|
|
2512 |
|
|
2513 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
2514 |
|
|
2515 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
|
2516 |
|
|
2517 int nr = rows (); |
|
|
2518 int nc = columns (); |
|
|
2519 |
|
|
2520 switch (jtype) |
|
|
2521 { |
|
|
2522 case complex_scalar_constant: |
|
|
2523 case scalar_constant: |
|
|
2524 { |
|
|
2525 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
2526 if (index_check (j, "column") < 0) |
|
|
2527 return tree_constant (); |
|
|
2528 if (range_max_check (tree_to_mat_idx (ri.max ()), j, nr, nc) < 0) |
|
|
2529 return tree_constant (); |
|
|
2530 retval = do_matrix_index (ri, j); |
|
|
2531 } |
|
|
2532 break; |
|
|
2533 |
|
|
2534 case complex_matrix_constant: |
|
|
2535 case matrix_constant: |
|
|
2536 { |
|
|
2537 Matrix mj = tmp_j.matrix_value (); |
|
|
2538 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
2539 if (! jv) |
|
|
2540 return tree_constant (); |
|
|
2541 |
|
|
2542 if (jv.length () == 0) |
|
|
2543 { |
|
|
2544 Matrix mtmp; |
|
|
2545 retval = tree_constant (mtmp); |
|
|
2546 } |
|
|
2547 else |
|
|
2548 { |
|
|
2549 if (range_max_check (tree_to_mat_idx (ri.max ()), |
|
|
2550 jv.max (), nr, nc) < 0) |
|
|
2551 return tree_constant (); |
|
|
2552 retval = do_matrix_index (ri, jv); |
|
|
2553 } |
|
|
2554 } |
|
|
2555 break; |
|
|
2556 |
|
|
2557 case string_constant: |
|
|
2558 gripe_string_invalid (); |
|
|
2559 break; |
|
|
2560 |
|
|
2561 case range_constant: |
|
|
2562 { |
|
|
2563 Range rj = tmp_j.range_value (); |
|
|
2564 if (nc == 2 && is_zero_one (rj)) |
|
|
2565 { |
|
|
2566 retval = do_matrix_index (ri, 1); |
|
|
2567 } |
|
|
2568 else if (nc == 2 && is_one_zero (rj)) |
|
|
2569 { |
|
|
2570 retval = do_matrix_index (ri, 0); |
|
|
2571 } |
|
|
2572 else |
|
|
2573 { |
|
|
2574 if (index_check (rj, "column") < 0) |
|
|
2575 return tree_constant (); |
|
|
2576 if (range_max_check (tree_to_mat_idx (ri.max ()), |
|
|
2577 tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
2578 return tree_constant (); |
|
|
2579 retval = do_matrix_index (ri, rj); |
|
|
2580 } |
|
|
2581 } |
|
|
2582 break; |
|
|
2583 |
|
|
2584 case magic_colon: |
|
|
2585 retval = do_matrix_index (ri, magic_colon); |
|
|
2586 break; |
|
|
2587 |
|
|
2588 default: |
|
|
2589 panic_impossible (); |
|
|
2590 break; |
|
|
2591 } |
|
|
2592 |
|
492
|
2593 return retval; |
|
|
2594 } |
|
|
2595 |
|
|
2596 tree_constant |
|
631
|
2597 TC_REP::do_matrix_index (TC_REP::constant_type mci, |
|
|
2598 const tree_constant& j_arg) const |
|
492
|
2599 { |
|
631
|
2600 tree_constant retval; |
|
|
2601 |
|
|
2602 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
2603 |
|
|
2604 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
|
2605 |
|
|
2606 int nr = rows (); |
|
|
2607 int nc = columns (); |
|
|
2608 |
|
|
2609 switch (jtype) |
|
|
2610 { |
|
|
2611 case complex_scalar_constant: |
|
|
2612 case scalar_constant: |
|
|
2613 { |
|
|
2614 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
2615 if (index_check (j, "column") < 0) |
|
|
2616 return tree_constant (); |
|
|
2617 if (range_max_check (0, j, nr, nc) < 0) |
|
|
2618 return tree_constant (); |
|
|
2619 retval = do_matrix_index (magic_colon, j); |
|
|
2620 } |
|
|
2621 break; |
|
|
2622 |
|
|
2623 case complex_matrix_constant: |
|
|
2624 case matrix_constant: |
|
|
2625 { |
|
|
2626 Matrix mj = tmp_j.matrix_value (); |
|
|
2627 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); |
|
|
2628 if (! jv) |
|
|
2629 return tree_constant (); |
|
|
2630 |
|
|
2631 if (jv.length () == 0) |
|
|
2632 { |
|
|
2633 Matrix mtmp; |
|
|
2634 retval = tree_constant (mtmp); |
|
|
2635 } |
|
|
2636 else |
|
|
2637 { |
|
|
2638 if (range_max_check (0, jv.max (), nr, nc) < 0) |
|
|
2639 return tree_constant (); |
|
|
2640 retval = do_matrix_index (magic_colon, jv); |
|
|
2641 } |
|
|
2642 } |
|
|
2643 break; |
|
|
2644 |
|
|
2645 case string_constant: |
|
|
2646 gripe_string_invalid (); |
|
|
2647 break; |
|
|
2648 |
|
|
2649 case range_constant: |
|
|
2650 { |
|
|
2651 Range rj = tmp_j.range_value (); |
|
|
2652 if (nc == 2 && is_zero_one (rj)) |
|
|
2653 { |
|
|
2654 retval = do_matrix_index (magic_colon, 1); |
|
|
2655 } |
|
|
2656 else if (nc == 2 && is_one_zero (rj)) |
|
|
2657 { |
|
|
2658 retval = do_matrix_index (magic_colon, 0); |
|
|
2659 } |
|
|
2660 else |
|
|
2661 { |
|
|
2662 if (index_check (rj, "column") < 0) |
|
|
2663 return tree_constant (); |
|
|
2664 if (range_max_check (0, tree_to_mat_idx (rj.max ()), nr, nc) < 0) |
|
|
2665 return tree_constant (); |
|
|
2666 retval = do_matrix_index (magic_colon, rj); |
|
|
2667 } |
|
|
2668 } |
|
|
2669 break; |
|
|
2670 |
|
|
2671 case magic_colon: |
|
|
2672 retval = do_matrix_index (magic_colon, magic_colon); |
|
|
2673 break; |
|
|
2674 |
|
|
2675 default: |
|
|
2676 panic_impossible (); |
|
|
2677 break; |
|
|
2678 } |
|
|
2679 |
|
|
2680 return retval; |
|
|
2681 } |
|
|
2682 |
|
|
2683 tree_constant |
|
|
2684 TC_REP::do_matrix_index (int i, int j) const |
|
|
2685 { |
|
|
2686 tree_constant retval; |
|
|
2687 |
|
|
2688 if (type_tag == matrix_constant) |
|
|
2689 retval = tree_constant (matrix->elem (i, j)); |
|
|
2690 else |
|
|
2691 retval = tree_constant (complex_matrix->elem (i, j)); |
|
|
2692 |
|
|
2693 return retval; |
|
|
2694 } |
|
|
2695 |
|
|
2696 tree_constant |
|
|
2697 TC_REP::do_matrix_index (int i, const idx_vector& jv) const |
|
|
2698 { |
|
|
2699 tree_constant retval; |
|
|
2700 |
|
|
2701 int jlen = jv.capacity (); |
|
|
2702 |
|
|
2703 CRMATRIX (m, cm, 1, jlen); |
|
|
2704 |
|
|
2705 for (int j = 0; j < jlen; j++) |
|
|
2706 { |
|
|
2707 int col = jv.elem (j); |
|
|
2708 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); |
|
|
2709 } |
|
|
2710 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2711 |
|
|
2712 return retval; |
|
|
2713 } |
|
|
2714 |
|
|
2715 tree_constant |
|
|
2716 TC_REP::do_matrix_index (int i, const Range& rj) const |
|
|
2717 { |
|
|
2718 tree_constant retval; |
|
|
2719 |
|
|
2720 int jlen = rj.nelem (); |
|
|
2721 |
|
|
2722 CRMATRIX (m, cm, 1, jlen); |
|
|
2723 |
|
|
2724 double b = rj.base (); |
|
|
2725 double increment = rj.inc (); |
|
|
2726 for (int j = 0; j < jlen; j++) |
|
|
2727 { |
|
|
2728 double tmp = b + j * increment; |
|
|
2729 int col = tree_to_mat_idx (tmp); |
|
|
2730 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); |
|
|
2731 } |
|
|
2732 |
|
|
2733 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2734 |
|
|
2735 return retval; |
|
|
2736 } |
|
|
2737 |
|
|
2738 tree_constant |
|
|
2739 TC_REP::do_matrix_index (int i, TC_REP::constant_type mcj) const |
|
|
2740 { |
|
|
2741 assert (mcj == magic_colon); |
|
492
|
2742 |
|
|
2743 tree_constant retval; |
|
|
2744 |
|
631
|
2745 int nc = columns (); |
|
|
2746 |
|
|
2747 CRMATRIX (m, cm, 1, nc); |
|
|
2748 |
|
|
2749 for (int j = 0; j < nc; j++) |
|
|
2750 { |
|
|
2751 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, j); |
|
|
2752 } |
|
|
2753 |
|
|
2754 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2755 |
|
|
2756 return retval; |
|
|
2757 } |
|
|
2758 |
|
|
2759 tree_constant |
|
|
2760 TC_REP::do_matrix_index (const idx_vector& iv, int j) const |
|
|
2761 { |
|
|
2762 tree_constant retval; |
|
|
2763 |
|
|
2764 int ilen = iv.capacity (); |
|
|
2765 |
|
|
2766 CRMATRIX (m, cm, ilen, 1); |
|
|
2767 |
|
|
2768 for (int i = 0; i < ilen; i++) |
|
|
2769 { |
|
|
2770 int row = iv.elem (i); |
|
|
2771 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); |
|
|
2772 } |
|
|
2773 |
|
|
2774 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2775 |
|
|
2776 return retval; |
|
|
2777 } |
|
|
2778 |
|
|
2779 tree_constant |
|
|
2780 TC_REP::do_matrix_index (const idx_vector& iv, const idx_vector& jv) const |
|
|
2781 { |
|
|
2782 tree_constant retval; |
|
|
2783 |
|
|
2784 int ilen = iv.capacity (); |
|
|
2785 int jlen = jv.capacity (); |
|
|
2786 |
|
|
2787 CRMATRIX (m, cm, ilen, jlen); |
|
|
2788 |
|
|
2789 for (int i = 0; i < ilen; i++) |
|
|
2790 { |
|
|
2791 int row = iv.elem (i); |
|
|
2792 for (int j = 0; j < jlen; j++) |
|
492
|
2793 { |
|
631
|
2794 int col = jv.elem (j); |
|
|
2795 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
492
|
2796 } |
|
631
|
2797 } |
|
|
2798 |
|
|
2799 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2800 |
|
|
2801 return retval; |
|
|
2802 } |
|
|
2803 |
|
|
2804 tree_constant |
|
|
2805 TC_REP::do_matrix_index (const idx_vector& iv, const Range& rj) const |
|
|
2806 { |
|
|
2807 tree_constant retval; |
|
|
2808 |
|
|
2809 int ilen = iv.capacity (); |
|
|
2810 int jlen = rj.nelem (); |
|
|
2811 |
|
|
2812 CRMATRIX (m, cm, ilen, jlen); |
|
|
2813 |
|
|
2814 double b = rj.base (); |
|
|
2815 double increment = rj.inc (); |
|
|
2816 |
|
|
2817 for (int i = 0; i < ilen; i++) |
|
|
2818 { |
|
|
2819 int row = iv.elem (i); |
|
|
2820 for (int j = 0; j < jlen; j++) |
|
492
|
2821 { |
|
631
|
2822 double tmp = b + j * increment; |
|
|
2823 int col = tree_to_mat_idx (tmp); |
|
|
2824 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
492
|
2825 } |
|
631
|
2826 } |
|
|
2827 |
|
|
2828 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2829 |
|
492
|
2830 return retval; |
|
|
2831 } |
|
|
2832 |
|
|
2833 tree_constant |
|
631
|
2834 TC_REP::do_matrix_index (const idx_vector& iv, |
|
|
2835 TC_REP::constant_type mcj) const |
|
|
2836 { |
|
|
2837 assert (mcj == magic_colon); |
|
|
2838 |
|
|
2839 tree_constant retval; |
|
|
2840 |
|
|
2841 int nc = columns (); |
|
|
2842 int ilen = iv.capacity (); |
|
|
2843 |
|
|
2844 CRMATRIX (m, cm, ilen, nc); |
|
|
2845 |
|
|
2846 for (int j = 0; j < nc; j++) |
|
|
2847 { |
|
|
2848 for (int i = 0; i < ilen; i++) |
|
|
2849 { |
|
|
2850 int row = iv.elem (i); |
|
|
2851 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); |
|
|
2852 } |
|
|
2853 } |
|
|
2854 |
|
|
2855 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2856 |
|
|
2857 return retval; |
|
|
2858 } |
|
|
2859 |
|
|
2860 tree_constant |
|
|
2861 TC_REP::do_matrix_index (const Range& ri, int j) const |
|
|
2862 { |
|
|
2863 tree_constant retval; |
|
|
2864 |
|
|
2865 int ilen = ri.nelem (); |
|
|
2866 |
|
|
2867 CRMATRIX (m, cm, ilen, 1); |
|
|
2868 |
|
|
2869 double b = ri.base (); |
|
|
2870 double increment = ri.inc (); |
|
|
2871 for (int i = 0; i < ilen; i++) |
|
|
2872 { |
|
|
2873 double tmp = b + i * increment; |
|
|
2874 int row = tree_to_mat_idx (tmp); |
|
|
2875 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); |
|
|
2876 } |
|
|
2877 |
|
|
2878 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2879 |
|
|
2880 return retval; |
|
|
2881 } |
|
|
2882 |
|
|
2883 tree_constant |
|
|
2884 TC_REP::do_matrix_index (const Range& ri, |
|
|
2885 const idx_vector& jv) const |
|
|
2886 { |
|
|
2887 tree_constant retval; |
|
|
2888 |
|
|
2889 int ilen = ri.nelem (); |
|
|
2890 int jlen = jv.capacity (); |
|
|
2891 |
|
|
2892 CRMATRIX (m, cm, ilen, jlen); |
|
|
2893 |
|
|
2894 double b = ri.base (); |
|
|
2895 double increment = ri.inc (); |
|
|
2896 for (int i = 0; i < ilen; i++) |
|
|
2897 { |
|
|
2898 double tmp = b + i * increment; |
|
|
2899 int row = tree_to_mat_idx (tmp); |
|
|
2900 for (int j = 0; j < jlen; j++) |
|
|
2901 { |
|
|
2902 int col = jv.elem (j); |
|
|
2903 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
2904 } |
|
|
2905 } |
|
|
2906 |
|
|
2907 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2908 |
|
|
2909 return retval; |
|
|
2910 } |
|
|
2911 |
|
|
2912 tree_constant |
|
|
2913 TC_REP::do_matrix_index (const Range& ri, const Range& rj) const |
|
492
|
2914 { |
|
|
2915 tree_constant retval; |
|
|
2916 |
|
631
|
2917 int ilen = ri.nelem (); |
|
|
2918 int jlen = rj.nelem (); |
|
|
2919 |
|
|
2920 CRMATRIX (m, cm, ilen, jlen); |
|
|
2921 |
|
|
2922 double ib = ri.base (); |
|
|
2923 double iinc = ri.inc (); |
|
|
2924 double jb = rj.base (); |
|
|
2925 double jinc = rj.inc (); |
|
|
2926 |
|
|
2927 for (int i = 0; i < ilen; i++) |
|
|
2928 { |
|
|
2929 double itmp = ib + i * iinc; |
|
|
2930 int row = tree_to_mat_idx (itmp); |
|
|
2931 for (int j = 0; j < jlen; j++) |
|
|
2932 { |
|
|
2933 double jtmp = jb + j * jinc; |
|
|
2934 int col = tree_to_mat_idx (jtmp); |
|
|
2935 |
|
|
2936 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); |
|
|
2937 } |
|
|
2938 } |
|
|
2939 |
|
|
2940 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2941 |
|
|
2942 return retval; |
|
|
2943 } |
|
|
2944 |
|
|
2945 tree_constant |
|
|
2946 TC_REP::do_matrix_index (const Range& ri, TC_REP::constant_type mcj) const |
|
|
2947 { |
|
|
2948 assert (mcj == magic_colon); |
|
|
2949 |
|
|
2950 tree_constant retval; |
|
|
2951 |
|
|
2952 int nc = columns (); |
|
|
2953 |
|
|
2954 int ilen = ri.nelem (); |
|
|
2955 |
|
|
2956 CRMATRIX (m, cm, ilen, nc); |
|
|
2957 |
|
|
2958 double ib = ri.base (); |
|
|
2959 double iinc = ri.inc (); |
|
|
2960 |
|
|
2961 for (int i = 0; i < ilen; i++) |
|
|
2962 { |
|
|
2963 double itmp = ib + i * iinc; |
|
|
2964 int row = tree_to_mat_idx (itmp); |
|
|
2965 for (int j = 0; j < nc; j++) |
|
|
2966 { |
|
|
2967 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); |
|
|
2968 } |
|
|
2969 } |
|
|
2970 |
|
|
2971 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2972 |
|
|
2973 return retval; |
|
|
2974 } |
|
|
2975 |
|
|
2976 tree_constant |
|
|
2977 TC_REP::do_matrix_index (TC_REP::constant_type mci, int j) const |
|
|
2978 { |
|
|
2979 assert (mci == magic_colon); |
|
|
2980 |
|
|
2981 tree_constant retval; |
|
|
2982 |
|
|
2983 int nr = rows (); |
|
|
2984 |
|
|
2985 CRMATRIX (m, cm, nr, 1); |
|
|
2986 |
|
|
2987 for (int i = 0; i < nr; i++) |
|
|
2988 { |
|
|
2989 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, i, j); |
|
|
2990 } |
|
|
2991 |
|
|
2992 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
2993 |
|
|
2994 return retval; |
|
|
2995 } |
|
|
2996 |
|
|
2997 tree_constant |
|
|
2998 TC_REP::do_matrix_index (TC_REP::constant_type mci, |
|
|
2999 const idx_vector& jv) const |
|
|
3000 { |
|
|
3001 assert (mci == magic_colon); |
|
|
3002 |
|
|
3003 tree_constant retval; |
|
|
3004 |
|
|
3005 int nr = rows (); |
|
|
3006 int jlen = jv.capacity (); |
|
|
3007 |
|
|
3008 CRMATRIX (m, cm, nr, jlen); |
|
|
3009 |
|
|
3010 for (int i = 0; i < nr; i++) |
|
|
3011 { |
|
|
3012 for (int j = 0; j < jlen; j++) |
|
|
3013 { |
|
|
3014 int col = jv.elem (j); |
|
|
3015 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); |
|
|
3016 } |
|
|
3017 } |
|
|
3018 |
|
|
3019 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
3020 |
|
|
3021 return retval; |
|
|
3022 } |
|
|
3023 |
|
|
3024 tree_constant |
|
|
3025 TC_REP::do_matrix_index (TC_REP::constant_type mci, const Range& rj) const |
|
|
3026 { |
|
|
3027 assert (mci == magic_colon); |
|
|
3028 |
|
|
3029 tree_constant retval; |
|
|
3030 |
|
|
3031 int nr = rows (); |
|
|
3032 int jlen = rj.nelem (); |
|
|
3033 |
|
|
3034 CRMATRIX (m, cm, nr, jlen); |
|
|
3035 |
|
|
3036 double jb = rj.base (); |
|
|
3037 double jinc = rj.inc (); |
|
|
3038 |
|
|
3039 for (int j = 0; j < jlen; j++) |
|
|
3040 { |
|
|
3041 double jtmp = jb + j * jinc; |
|
|
3042 int col = tree_to_mat_idx (jtmp); |
|
|
3043 for (int i = 0; i < nr; i++) |
|
|
3044 { |
|
|
3045 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); |
|
|
3046 } |
|
|
3047 } |
|
|
3048 |
|
|
3049 ASSIGN_CRMATRIX_TO (retval, m, cm); |
|
|
3050 |
|
|
3051 return retval; |
|
|
3052 } |
|
|
3053 |
|
|
3054 tree_constant |
|
|
3055 TC_REP::do_matrix_index (TC_REP::constant_type mci, |
|
|
3056 TC_REP::constant_type mcj) const |
|
|
3057 { |
|
|
3058 tree_constant retval; |
|
|
3059 |
|
|
3060 assert (mci == magic_colon && mcj == magic_colon); |
|
492
|
3061 |
|
|
3062 switch (type_tag) |
|
|
3063 { |
|
631
|
3064 case complex_scalar_constant: |
|
|
3065 retval = *complex_scalar; |
|
|
3066 break; |
|
|
3067 |
|
492
|
3068 case scalar_constant: |
|
631
|
3069 retval = scalar; |
|
492
|
3070 break; |
|
|
3071 case complex_matrix_constant: |
|
631
|
3072 |
|
|
3073 retval = *complex_matrix; |
|
|
3074 break; |
|
|
3075 |
|
|
3076 case matrix_constant: |
|
|
3077 retval = *matrix; |
|
|
3078 break; |
|
|
3079 |
|
|
3080 case range_constant: |
|
|
3081 retval = *range; |
|
|
3082 break; |
|
|
3083 |
|
492
|
3084 case string_constant: |
|
631
|
3085 retval = string; |
|
|
3086 break; |
|
|
3087 |
|
492
|
3088 case magic_colon: |
|
|
3089 default: |
|
|
3090 panic_impossible (); |
|
|
3091 break; |
|
|
3092 } |
|
631
|
3093 |
|
492
|
3094 return retval; |
|
|
3095 } |
|
|
3096 |
|
581
|
3097 // Top-level tree-constant function that handles assignments. Only |
|
|
3098 // decide if the left-hand side is currently a scalar or a matrix and |
|
|
3099 // hand off to other functions to do the real work. |
|
|
3100 |
|
492
|
3101 void |
|
631
|
3102 TC_REP::assign (const tree_constant& rhs, const Octave_object& args) |
|
492
|
3103 { |
|
|
3104 tree_constant rhs_tmp = rhs.make_numeric (); |
|
|
3105 |
|
|
3106 // This is easier than actually handling assignments to strings. |
|
|
3107 // An assignment to a range will normally require a conversion to a |
|
|
3108 // vector since it will normally destroy the equally-spaced property |
|
|
3109 // of the range elements. |
|
|
3110 |
|
|
3111 if (type_tag == string_constant || type_tag == range_constant) |
|
|
3112 force_numeric (); |
|
|
3113 |
|
|
3114 switch (type_tag) |
|
|
3115 { |
|
|
3116 case complex_scalar_constant: |
|
|
3117 case scalar_constant: |
|
|
3118 case unknown_constant: |
|
506
|
3119 do_scalar_assignment (rhs_tmp, args); |
|
492
|
3120 break; |
|
631
|
3121 |
|
492
|
3122 case complex_matrix_constant: |
|
|
3123 case matrix_constant: |
|
506
|
3124 do_matrix_assignment (rhs_tmp, args); |
|
492
|
3125 break; |
|
631
|
3126 |
|
492
|
3127 case string_constant: |
|
|
3128 ::error ("invalid assignment to string type"); |
|
|
3129 break; |
|
631
|
3130 |
|
492
|
3131 case range_constant: |
|
|
3132 case magic_colon: |
|
|
3133 default: |
|
|
3134 panic_impossible (); |
|
|
3135 break; |
|
|
3136 } |
|
|
3137 } |
|
|
3138 |
|
581
|
3139 // Assignments to scalars. If resize_on_range_error is true, |
|
|
3140 // this can convert the left-hand side to a matrix. |
|
|
3141 |
|
492
|
3142 void |
|
631
|
3143 TC_REP::do_scalar_assignment (const tree_constant& rhs, |
|
|
3144 const Octave_object& args) |
|
492
|
3145 { |
|
|
3146 assert (type_tag == unknown_constant |
|
|
3147 || type_tag == scalar_constant |
|
|
3148 || type_tag == complex_scalar_constant); |
|
|
3149 |
|
506
|
3150 int nargin = args.length (); |
|
|
3151 |
|
492
|
3152 if ((rhs.is_scalar_type () || rhs.is_zero_by_zero ()) |
|
506
|
3153 && valid_scalar_indices (args)) |
|
492
|
3154 { |
|
|
3155 if (rhs.is_zero_by_zero ()) |
|
|
3156 { |
|
|
3157 if (type_tag == complex_scalar_constant) |
|
|
3158 delete complex_scalar; |
|
|
3159 |
|
|
3160 matrix = new Matrix (0, 0); |
|
|
3161 type_tag = matrix_constant; |
|
|
3162 } |
|
|
3163 else if (type_tag == unknown_constant || type_tag == scalar_constant) |
|
|
3164 { |
|
|
3165 if (rhs.const_type () == scalar_constant) |
|
|
3166 { |
|
|
3167 scalar = rhs.double_value (); |
|
|
3168 type_tag = scalar_constant; |
|
|
3169 } |
|
|
3170 else if (rhs.const_type () == complex_scalar_constant) |
|
|
3171 { |
|
|
3172 complex_scalar = new Complex (rhs.complex_value ()); |
|
|
3173 type_tag = complex_scalar_constant; |
|
|
3174 } |
|
|
3175 else |
|
|
3176 { |
|
|
3177 ::error ("invalid assignment to scalar"); |
|
|
3178 return; |
|
|
3179 } |
|
|
3180 } |
|
|
3181 else |
|
|
3182 { |
|
|
3183 if (rhs.const_type () == scalar_constant) |
|
|
3184 { |
|
|
3185 delete complex_scalar; |
|
|
3186 scalar = rhs.double_value (); |
|
|
3187 type_tag = scalar_constant; |
|
|
3188 } |
|
|
3189 else if (rhs.const_type () == complex_scalar_constant) |
|
|
3190 { |
|
|
3191 *complex_scalar = rhs.complex_value (); |
|
|
3192 type_tag = complex_scalar_constant; |
|
|
3193 } |
|
|
3194 else |
|
|
3195 { |
|
|
3196 ::error ("invalid assignment to scalar"); |
|
|
3197 return; |
|
|
3198 } |
|
|
3199 } |
|
|
3200 } |
|
|
3201 else if (user_pref.resize_on_range_error) |
|
|
3202 { |
|
631
|
3203 TC_REP::constant_type old_type_tag = type_tag; |
|
492
|
3204 |
|
|
3205 if (type_tag == complex_scalar_constant) |
|
|
3206 { |
|
|
3207 Complex *old_complex = complex_scalar; |
|
|
3208 complex_matrix = new ComplexMatrix (1, 1, *complex_scalar); |
|
|
3209 type_tag = complex_matrix_constant; |
|
|
3210 delete old_complex; |
|
|
3211 } |
|
|
3212 else if (type_tag == scalar_constant) |
|
|
3213 { |
|
|
3214 matrix = new Matrix (1, 1, scalar); |
|
|
3215 type_tag = matrix_constant; |
|
|
3216 } |
|
|
3217 |
|
|
3218 // If there is an error, the call to do_matrix_assignment should not |
|
631
|
3219 // destroy the current value. |
|
|
3220 // TC_REP::eval(int) will take |
|
492
|
3221 // care of converting single element matrices back to scalars. |
|
|
3222 |
|
506
|
3223 do_matrix_assignment (rhs, args); |
|
492
|
3224 |
|
|
3225 // I don't think there's any other way to revert back to unknown |
|
|
3226 // constant types, so here it is. |
|
|
3227 |
|
|
3228 if (old_type_tag == unknown_constant && error_state) |
|
|
3229 { |
|
|
3230 if (type_tag == matrix_constant) |
|
|
3231 delete matrix; |
|
|
3232 else if (type_tag == complex_matrix_constant) |
|
|
3233 delete complex_matrix; |
|
|
3234 |
|
|
3235 type_tag = unknown_constant; |
|
|
3236 } |
|
|
3237 } |
|
506
|
3238 else if (nargin > 3 || nargin < 2) |
|
492
|
3239 ::error ("invalid index expression for scalar type"); |
|
|
3240 else |
|
|
3241 ::error ("index invalid or out of range for scalar type"); |
|
|
3242 } |
|
|
3243 |
|
581
|
3244 // Assignments to matrices (and vectors). |
|
|
3245 // |
|
|
3246 // For compatibility with Matlab, we allow assignment of an empty |
|
|
3247 // matrix to an expression with empty indices to do nothing. |
|
|
3248 |
|
492
|
3249 void |
|
631
|
3250 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
3251 const Octave_object& args) |
|
492
|
3252 { |
|
|
3253 assert (type_tag == unknown_constant |
|
|
3254 || type_tag == matrix_constant |
|
|
3255 || type_tag == complex_matrix_constant); |
|
|
3256 |
|
|
3257 if (type_tag == matrix_constant && rhs.is_complex_type ()) |
|
|
3258 { |
|
|
3259 Matrix *old_matrix = matrix; |
|
|
3260 complex_matrix = new ComplexMatrix (*matrix); |
|
|
3261 type_tag = complex_matrix_constant; |
|
|
3262 delete old_matrix; |
|
|
3263 } |
|
|
3264 else if (type_tag == unknown_constant) |
|
|
3265 { |
|
|
3266 if (rhs.is_complex_type ()) |
|
|
3267 { |
|
|
3268 complex_matrix = new ComplexMatrix (); |
|
|
3269 type_tag = complex_matrix_constant; |
|
|
3270 } |
|
|
3271 else |
|
|
3272 { |
|
|
3273 matrix = new Matrix (); |
|
|
3274 type_tag = matrix_constant; |
|
|
3275 } |
|
|
3276 } |
|
|
3277 |
|
506
|
3278 int nargin = args.length (); |
|
|
3279 |
|
492
|
3280 // The do_matrix_assignment functions can't handle empty matrices, so |
|
|
3281 // don't let any pass through here. |
|
506
|
3282 switch (nargin) |
|
492
|
3283 { |
|
|
3284 case 2: |
|
500
|
3285 if (args.length () <= 0) |
|
492
|
3286 ::error ("matrix index is null"); |
|
500
|
3287 else if (args(1).is_undefined ()) |
|
492
|
3288 ::error ("matrix index is undefined"); |
|
|
3289 else |
|
500
|
3290 do_matrix_assignment (rhs, args(1)); |
|
492
|
3291 break; |
|
631
|
3292 |
|
492
|
3293 case 3: |
|
500
|
3294 if (args.length () <= 0) |
|
492
|
3295 ::error ("matrix indices are null"); |
|
500
|
3296 else if (args(1).is_undefined ()) |
|
492
|
3297 ::error ("first matrix index is undefined"); |
|
500
|
3298 else if (args(2).is_undefined ()) |
|
492
|
3299 ::error ("second matrix index is undefined"); |
|
500
|
3300 else if (args(1).is_empty () || args(2).is_empty ()) |
|
492
|
3301 { |
|
|
3302 if (! rhs.is_empty ()) |
|
|
3303 { |
|
|
3304 ::error ("in assignment expression, a matrix index is empty"); |
|
|
3305 ::error ("but hte right hand side is not an empty matrix"); |
|
|
3306 } |
|
|
3307 // XXX FIXME XXX -- to really be correct here, we should probably |
|
|
3308 // check to see if the assignment conforms, but that seems like more |
|
|
3309 // work than it's worth right now... |
|
|
3310 } |
|
|
3311 else |
|
500
|
3312 do_matrix_assignment (rhs, args(1), args(2)); |
|
492
|
3313 break; |
|
631
|
3314 |
|
492
|
3315 default: |
|
|
3316 ::error ("too many indices for matrix expression"); |
|
|
3317 break; |
|
|
3318 } |
|
|
3319 } |
|
|
3320 |
|
581
|
3321 // Matrix assignments indexed by a single value. |
|
|
3322 |
|
492
|
3323 void |
|
631
|
3324 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
3325 const tree_constant& i_arg) |
|
492
|
3326 { |
|
|
3327 int nr = rows (); |
|
|
3328 int nc = columns (); |
|
|
3329 |
|
|
3330 if (user_pref.do_fortran_indexing || nr <= 1 || nc <= 1) |
|
|
3331 { |
|
|
3332 if (i_arg.is_empty ()) |
|
|
3333 { |
|
|
3334 if (! rhs.is_empty ()) |
|
|
3335 { |
|
|
3336 ::error ("in assignment expression, matrix index is empty but"); |
|
|
3337 ::error ("right hand side is not an empty matrix"); |
|
|
3338 } |
|
|
3339 // XXX FIXME XXX -- to really be correct here, we should probably |
|
|
3340 // check to see if the assignment conforms, but that seems like more |
|
|
3341 // work than it's worth right now... |
|
|
3342 |
|
|
3343 // The assignment functions can't handle empty matrices, so don't let |
|
|
3344 // any pass through here. |
|
|
3345 return; |
|
|
3346 } |
|
|
3347 |
|
|
3348 // We can't handle the case of assigning to a vector first, since even |
|
|
3349 // then, the two operations are not equivalent. For example, the |
|
|
3350 // expression V(:) = M is handled differently depending on whether the |
|
|
3351 // user specified do_fortran_indexing = "true". |
|
|
3352 |
|
|
3353 if (user_pref.do_fortran_indexing) |
|
|
3354 fortran_style_matrix_assignment (rhs, i_arg); |
|
|
3355 else if (nr <= 1 || nc <= 1) |
|
|
3356 vector_assignment (rhs, i_arg); |
|
|
3357 else |
|
|
3358 panic_impossible (); |
|
|
3359 } |
|
|
3360 else |
|
|
3361 ::error ("single index only valid for row or column vector"); |
|
|
3362 } |
|
|
3363 |
|
581
|
3364 // Fortran-style assignments. Matrices are assumed to be stored in |
|
|
3365 // column-major order and it is ok to use a single index for |
|
|
3366 // multi-dimensional matrices. |
|
|
3367 |
|
492
|
3368 void |
|
631
|
3369 TC_REP::fortran_style_matrix_assignment (const tree_constant& rhs, |
|
|
3370 const tree_constant& i_arg) |
|
492
|
3371 { |
|
|
3372 tree_constant tmp_i = i_arg.make_numeric_or_magic (); |
|
|
3373 |
|
631
|
3374 TC_REP::constant_type itype = tmp_i.const_type (); |
|
492
|
3375 |
|
|
3376 int nr = rows (); |
|
|
3377 int nc = columns (); |
|
|
3378 |
|
|
3379 int rhs_nr = rhs.rows (); |
|
|
3380 int rhs_nc = rhs.columns (); |
|
|
3381 |
|
|
3382 switch (itype) |
|
|
3383 { |
|
|
3384 case complex_scalar_constant: |
|
|
3385 case scalar_constant: |
|
|
3386 { |
|
|
3387 int i = NINT (tmp_i.double_value ()); |
|
|
3388 int idx = i - 1; |
|
|
3389 |
|
|
3390 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3391 { |
|
|
3392 if (idx < nr * nc) |
|
|
3393 { |
|
|
3394 convert_to_row_or_column_vector (); |
|
|
3395 |
|
|
3396 nr = rows (); |
|
|
3397 nc = columns (); |
|
|
3398 |
|
|
3399 if (nr == 1) |
|
|
3400 delete_column (idx); |
|
|
3401 else if (nc == 1) |
|
|
3402 delete_row (idx); |
|
|
3403 else |
|
|
3404 panic_impossible (); |
|
|
3405 } |
|
|
3406 return; |
|
|
3407 } |
|
|
3408 |
|
|
3409 if (index_check (idx, "") < 0) |
|
|
3410 return; |
|
|
3411 |
|
|
3412 if (nr <= 1 || nc <= 1) |
|
|
3413 { |
|
|
3414 maybe_resize (idx); |
|
|
3415 if (error_state) |
|
|
3416 return; |
|
|
3417 } |
|
|
3418 else if (range_max_check (idx, nr * nc) < 0) |
|
|
3419 return; |
|
|
3420 |
|
|
3421 nr = rows (); |
|
|
3422 nc = columns (); |
|
|
3423 |
|
|
3424 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
3425 { |
|
|
3426 ::error ("for A(int) = X: X must be a scalar"); |
|
|
3427 return; |
|
|
3428 } |
|
|
3429 int ii = fortran_row (i, nr) - 1; |
|
|
3430 int jj = fortran_column (i, nr) - 1; |
|
|
3431 do_matrix_assignment (rhs, ii, jj); |
|
|
3432 } |
|
|
3433 break; |
|
631
|
3434 |
|
492
|
3435 case complex_matrix_constant: |
|
|
3436 case matrix_constant: |
|
|
3437 { |
|
|
3438 Matrix mi = tmp_i.matrix_value (); |
|
|
3439 int len = nr * nc; |
|
|
3440 idx_vector ii (mi, 1, "", len); // Always do fortran indexing here... |
|
|
3441 if (! ii) |
|
|
3442 return; |
|
|
3443 |
|
|
3444 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3445 { |
|
|
3446 ii.sort_uniq (); |
|
|
3447 int num_to_delete = 0; |
|
|
3448 for (int i = 0; i < ii.length (); i++) |
|
|
3449 { |
|
|
3450 if (ii.elem (i) < len) |
|
|
3451 num_to_delete++; |
|
|
3452 else |
|
|
3453 break; |
|
|
3454 } |
|
|
3455 |
|
|
3456 if (num_to_delete > 0) |
|
|
3457 { |
|
|
3458 if (num_to_delete != ii.length ()) |
|
|
3459 ii.shorten (num_to_delete); |
|
|
3460 |
|
|
3461 convert_to_row_or_column_vector (); |
|
|
3462 |
|
|
3463 nr = rows (); |
|
|
3464 nc = columns (); |
|
|
3465 |
|
|
3466 if (nr == 1) |
|
|
3467 delete_columns (ii); |
|
|
3468 else if (nc == 1) |
|
|
3469 delete_rows (ii); |
|
|
3470 else |
|
|
3471 panic_impossible (); |
|
|
3472 } |
|
|
3473 return; |
|
|
3474 } |
|
|
3475 |
|
|
3476 if (nr <= 1 || nc <= 1) |
|
|
3477 { |
|
|
3478 maybe_resize (ii.max ()); |
|
|
3479 if (error_state) |
|
|
3480 return; |
|
|
3481 } |
|
|
3482 else if (range_max_check (ii.max (), len) < 0) |
|
|
3483 return; |
|
|
3484 |
|
|
3485 int ilen = ii.capacity (); |
|
|
3486 |
|
|
3487 if (ilen != rhs_nr * rhs_nc) |
|
|
3488 { |
|
|
3489 ::error ("A(matrix) = X: X and matrix must have the same number"); |
|
|
3490 ::error ("of elements"); |
|
|
3491 } |
|
|
3492 else if (ilen == 1 && rhs.is_scalar_type ()) |
|
|
3493 { |
|
|
3494 int nr = rows (); |
|
|
3495 int idx = ii.elem (0); |
|
|
3496 int ii = fortran_row (idx + 1, nr) - 1; |
|
|
3497 int jj = fortran_column (idx + 1, nr) - 1; |
|
|
3498 |
|
|
3499 if (rhs.const_type () == scalar_constant) |
|
|
3500 matrix->elem (ii, jj) = rhs.double_value (); |
|
|
3501 else if (rhs.const_type () == complex_scalar_constant) |
|
|
3502 complex_matrix->elem (ii, jj) = rhs.complex_value (); |
|
|
3503 else |
|
|
3504 panic_impossible (); |
|
|
3505 } |
|
|
3506 else |
|
|
3507 fortran_style_matrix_assignment (rhs, ii); |
|
|
3508 } |
|
|
3509 break; |
|
631
|
3510 |
|
492
|
3511 case string_constant: |
|
|
3512 gripe_string_invalid (); |
|
|
3513 break; |
|
631
|
3514 |
|
492
|
3515 case range_constant: |
|
|
3516 gripe_range_invalid (); |
|
|
3517 break; |
|
631
|
3518 |
|
492
|
3519 case magic_colon: |
|
|
3520 // a(:) = [] is equivalent to a(:,:) = []. |
|
|
3521 if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3522 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
3523 else |
|
|
3524 fortran_style_matrix_assignment (rhs, magic_colon); |
|
|
3525 break; |
|
631
|
3526 |
|
492
|
3527 default: |
|
|
3528 panic_impossible (); |
|
|
3529 break; |
|
|
3530 } |
|
|
3531 } |
|
|
3532 |
|
581
|
3533 // Fortran-style assignment for vector index. |
|
|
3534 |
|
492
|
3535 void |
|
631
|
3536 TC_REP::fortran_style_matrix_assignment (const tree_constant& rhs, |
|
|
3537 idx_vector& i) |
|
492
|
3538 { |
|
|
3539 assert (rhs.is_matrix_type ()); |
|
|
3540 |
|
|
3541 int ilen = i.capacity (); |
|
|
3542 |
|
|
3543 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3544 |
|
|
3545 int len = rhs_nr * rhs_nc; |
|
|
3546 |
|
|
3547 if (len == ilen) |
|
|
3548 { |
|
|
3549 int nr = rows (); |
|
|
3550 if (rhs.const_type () == matrix_constant) |
|
|
3551 { |
|
|
3552 double *cop_out = rhs_m.fortran_vec (); |
|
|
3553 for (int k = 0; k < len; k++) |
|
|
3554 { |
|
|
3555 int ii = fortran_row (i.elem (k) + 1, nr) - 1; |
|
|
3556 int jj = fortran_column (i.elem (k) + 1, nr) - 1; |
|
|
3557 |
|
|
3558 matrix->elem (ii, jj) = *cop_out++; |
|
|
3559 } |
|
|
3560 } |
|
|
3561 else |
|
|
3562 { |
|
|
3563 Complex *cop_out = rhs_cm.fortran_vec (); |
|
|
3564 for (int k = 0; k < len; k++) |
|
|
3565 { |
|
|
3566 int ii = fortran_row (i.elem (k) + 1, nr) - 1; |
|
|
3567 int jj = fortran_column (i.elem (k) + 1, nr) - 1; |
|
|
3568 |
|
|
3569 complex_matrix->elem (ii, jj) = *cop_out++; |
|
|
3570 } |
|
|
3571 } |
|
|
3572 } |
|
|
3573 else |
|
|
3574 ::error ("number of rows and columns must match for indexed assignment"); |
|
|
3575 } |
|
|
3576 |
|
581
|
3577 // Fortran-style assignment for colon index. |
|
|
3578 |
|
492
|
3579 void |
|
631
|
3580 TC_REP::fortran_style_matrix_assignment (const tree_constant& rhs, |
|
|
3581 TC_REP::constant_type mci) |
|
492
|
3582 { |
|
631
|
3583 assert (rhs.is_matrix_type () && mci == TC_REP::magic_colon); |
|
492
|
3584 |
|
|
3585 int nr = rows (); |
|
|
3586 int nc = columns (); |
|
|
3587 |
|
|
3588 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3589 |
|
|
3590 int rhs_size = rhs_nr * rhs_nc; |
|
|
3591 if (rhs_size == 0) |
|
|
3592 { |
|
|
3593 if (rhs.const_type () == matrix_constant) |
|
|
3594 { |
|
|
3595 delete matrix; |
|
|
3596 matrix = new Matrix (0, 0); |
|
|
3597 return; |
|
|
3598 } |
|
|
3599 else |
|
|
3600 panic_impossible (); |
|
|
3601 } |
|
|
3602 else if (nr*nc != rhs_size) |
|
|
3603 { |
|
|
3604 ::error ("A(:) = X: X and A must have the same number of elements"); |
|
|
3605 return; |
|
|
3606 } |
|
|
3607 |
|
|
3608 if (rhs.const_type () == matrix_constant) |
|
|
3609 { |
|
|
3610 double *cop_out = rhs_m.fortran_vec (); |
|
|
3611 for (int j = 0; j < nc; j++) |
|
|
3612 for (int i = 0; i < nr; i++) |
|
|
3613 matrix->elem (i, j) = *cop_out++; |
|
|
3614 } |
|
|
3615 else |
|
|
3616 { |
|
|
3617 Complex *cop_out = rhs_cm.fortran_vec (); |
|
|
3618 for (int j = 0; j < nc; j++) |
|
|
3619 for (int i = 0; i < nr; i++) |
|
|
3620 complex_matrix->elem (i, j) = *cop_out++; |
|
|
3621 } |
|
|
3622 } |
|
|
3623 |
|
581
|
3624 // Assignments to vectors. Hand off to other functions once we know |
|
|
3625 // what kind of index we have. For a colon, it is the same as |
|
|
3626 // assignment to a matrix indexed by two colons. |
|
|
3627 |
|
492
|
3628 void |
|
631
|
3629 TC_REP::vector_assignment (const tree_constant& rhs, |
|
|
3630 const tree_constant& i_arg) |
|
492
|
3631 { |
|
|
3632 int nr = rows (); |
|
|
3633 int nc = columns (); |
|
|
3634 |
|
|
3635 assert ((nr == 1 || nc == 1 || (nr == 0 && nc == 0)) |
|
|
3636 && ! user_pref.do_fortran_indexing); |
|
|
3637 |
|
|
3638 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
3639 |
|
631
|
3640 TC_REP::constant_type itype = tmp_i.const_type (); |
|
492
|
3641 |
|
|
3642 switch (itype) |
|
|
3643 { |
|
|
3644 case complex_scalar_constant: |
|
|
3645 case scalar_constant: |
|
|
3646 { |
|
|
3647 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
3648 if (index_check (i, "") < 0) |
|
|
3649 return; |
|
|
3650 do_vector_assign (rhs, i); |
|
|
3651 } |
|
|
3652 break; |
|
631
|
3653 |
|
492
|
3654 case complex_matrix_constant: |
|
|
3655 case matrix_constant: |
|
|
3656 { |
|
|
3657 Matrix mi = tmp_i.matrix_value (); |
|
|
3658 int len = nr * nc; |
|
|
3659 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); |
|
|
3660 if (! iv) |
|
|
3661 return; |
|
|
3662 |
|
|
3663 do_vector_assign (rhs, iv); |
|
|
3664 } |
|
|
3665 break; |
|
631
|
3666 |
|
492
|
3667 case string_constant: |
|
|
3668 gripe_string_invalid (); |
|
|
3669 break; |
|
631
|
3670 |
|
492
|
3671 case range_constant: |
|
|
3672 { |
|
|
3673 Range ri = tmp_i.range_value (); |
|
|
3674 int len = nr * nc; |
|
|
3675 if (len == 2 && is_zero_one (ri)) |
|
|
3676 { |
|
|
3677 do_vector_assign (rhs, 1); |
|
|
3678 } |
|
|
3679 else if (len == 2 && is_one_zero (ri)) |
|
|
3680 { |
|
|
3681 do_vector_assign (rhs, 0); |
|
|
3682 } |
|
|
3683 else |
|
|
3684 { |
|
|
3685 if (index_check (ri, "") < 0) |
|
|
3686 return; |
|
|
3687 do_vector_assign (rhs, ri); |
|
|
3688 } |
|
|
3689 } |
|
|
3690 break; |
|
631
|
3691 |
|
492
|
3692 case magic_colon: |
|
|
3693 { |
|
|
3694 int rhs_nr = rhs.rows (); |
|
|
3695 int rhs_nc = rhs.columns (); |
|
|
3696 |
|
|
3697 if (! indexed_assign_conforms (nr, nc, rhs_nr, rhs_nc)) |
|
|
3698 { |
|
|
3699 ::error ("A(:) = X: X and A must have the same dimensions"); |
|
|
3700 return; |
|
|
3701 } |
|
|
3702 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
3703 } |
|
|
3704 break; |
|
|
3705 default: |
|
|
3706 panic_impossible (); |
|
|
3707 break; |
|
|
3708 } |
|
|
3709 } |
|
|
3710 |
|
581
|
3711 // Check whether an indexed assignment to a vector is valid. |
|
|
3712 |
|
492
|
3713 void |
|
631
|
3714 TC_REP::check_vector_assign (int rhs_nr, int rhs_nc, int ilen, const char *rm) |
|
492
|
3715 { |
|
|
3716 int nr = rows (); |
|
|
3717 int nc = columns (); |
|
|
3718 |
|
|
3719 if ((nr == 1 && nc == 1) || nr == 0 || nc == 0) // No orientation. |
|
|
3720 { |
|
|
3721 if (! (ilen == rhs_nr || ilen == rhs_nc)) |
|
|
3722 { |
|
|
3723 ::error ("A(%s) = X: X and %s must have the same number of elements", |
|
|
3724 rm, rm); |
|
|
3725 } |
|
|
3726 } |
|
|
3727 else if (nr == 1) // Preserve current row orientation. |
|
|
3728 { |
|
|
3729 if (! (rhs_nr == 1 && rhs_nc == ilen)) |
|
|
3730 { |
|
|
3731 ::error ("A(%s) = X: where A is a row vector, X must also be a", rm); |
|
|
3732 ::error ("row vector with the same number of elements as %s", rm); |
|
|
3733 } |
|
|
3734 } |
|
|
3735 else if (nc == 1) // Preserve current column orientation. |
|
|
3736 { |
|
|
3737 if (! (rhs_nc == 1 && rhs_nr == ilen)) |
|
|
3738 { |
|
|
3739 ::error ("A(%s) = X: where A is a column vector, X must also be", rm); |
|
|
3740 ::error ("a column vector with the same number of elements as %s", rm); |
|
|
3741 } |
|
|
3742 } |
|
|
3743 else |
|
|
3744 panic_impossible (); |
|
|
3745 } |
|
|
3746 |
|
581
|
3747 // Assignment to a vector with an integer index. |
|
|
3748 |
|
492
|
3749 void |
|
631
|
3750 TC_REP::do_vector_assign (const tree_constant& rhs, int i) |
|
492
|
3751 { |
|
|
3752 int rhs_nr = rhs.rows (); |
|
|
3753 int rhs_nc = rhs.columns (); |
|
|
3754 |
|
|
3755 if (indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
3756 { |
|
|
3757 maybe_resize (i); |
|
|
3758 if (error_state) |
|
|
3759 return; |
|
|
3760 |
|
|
3761 int nr = rows (); |
|
|
3762 int nc = columns (); |
|
|
3763 |
|
|
3764 if (nr == 1) |
|
|
3765 { |
|
|
3766 REP_ELEM_ASSIGN (0, i, rhs.double_value (), rhs.complex_value (), |
|
|
3767 rhs.is_real_type ()); |
|
|
3768 } |
|
|
3769 else if (nc == 1) |
|
|
3770 { |
|
|
3771 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), rhs.complex_value (), |
|
|
3772 rhs.is_real_type ()); |
|
|
3773 } |
|
|
3774 else |
|
|
3775 panic_impossible (); |
|
|
3776 } |
|
|
3777 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
3778 { |
|
|
3779 int nr = rows (); |
|
|
3780 int nc = columns (); |
|
|
3781 |
|
|
3782 int len = MAX (nr, nc); |
|
|
3783 |
|
|
3784 if (i < 0 || i >= len) |
|
|
3785 { |
|
|
3786 ::error ("A(int) = []: index out of range"); |
|
|
3787 return; |
|
|
3788 } |
|
|
3789 |
|
|
3790 if (nr == 1) |
|
|
3791 delete_column (i); |
|
|
3792 else if (nc == 1) |
|
|
3793 delete_row (i); |
|
|
3794 else |
|
|
3795 panic_impossible (); |
|
|
3796 } |
|
|
3797 else |
|
|
3798 { |
|
|
3799 ::error ("for A(int) = X: X must be a scalar"); |
|
|
3800 return; |
|
|
3801 } |
|
|
3802 } |
|
|
3803 |
|
581
|
3804 // Assignment to a vector with a vector index. |
|
|
3805 |
|
492
|
3806 void |
|
631
|
3807 TC_REP::do_vector_assign (const tree_constant& rhs, idx_vector& iv) |
|
492
|
3808 { |
|
|
3809 if (rhs.is_zero_by_zero ()) |
|
|
3810 { |
|
|
3811 int nr = rows (); |
|
|
3812 int nc = columns (); |
|
|
3813 |
|
|
3814 int len = MAX (nr, nc); |
|
|
3815 |
|
|
3816 if (iv.max () >= len) |
|
|
3817 { |
|
|
3818 ::error ("A(matrix) = []: index out of range"); |
|
|
3819 return; |
|
|
3820 } |
|
|
3821 |
|
|
3822 if (nr == 1) |
|
|
3823 delete_columns (iv); |
|
|
3824 else if (nc == 1) |
|
|
3825 delete_rows (iv); |
|
|
3826 else |
|
|
3827 panic_impossible (); |
|
|
3828 } |
|
|
3829 else if (rhs.is_scalar_type ()) |
|
|
3830 { |
|
|
3831 int nr = rows (); |
|
|
3832 int nc = columns (); |
|
|
3833 |
|
|
3834 if (iv.capacity () == 1) |
|
|
3835 { |
|
|
3836 int idx = iv.elem (0); |
|
|
3837 |
|
|
3838 if (nr == 1) |
|
|
3839 { |
|
|
3840 REP_ELEM_ASSIGN (0, idx, rhs.double_value (), |
|
|
3841 rhs.complex_value (), rhs.is_real_type ()); |
|
|
3842 } |
|
|
3843 else if (nc == 1) |
|
|
3844 { |
|
|
3845 REP_ELEM_ASSIGN (idx, 0, rhs.double_value (), |
|
|
3846 rhs.complex_value (), rhs.is_real_type ()); |
|
|
3847 } |
|
|
3848 else |
|
|
3849 panic_impossible (); |
|
|
3850 } |
|
|
3851 else |
|
|
3852 { |
|
|
3853 if (nr == 1) |
|
|
3854 { |
|
|
3855 ::error ("A(matrix) = X: where A is a row vector, X must also be a"); |
|
|
3856 ::error ("row vector with the same number of elements as matrix"); |
|
|
3857 } |
|
|
3858 else if (nc == 1) |
|
|
3859 { |
|
|
3860 ::error ("A(matrix) = X: where A is a column vector, X must also be a"); |
|
|
3861 ::error ("column vector with the same number of elements as matrix"); |
|
|
3862 } |
|
|
3863 else |
|
|
3864 panic_impossible (); |
|
|
3865 } |
|
|
3866 } |
|
|
3867 else if (rhs.is_matrix_type ()) |
|
|
3868 { |
|
|
3869 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3870 |
|
|
3871 int ilen = iv.capacity (); |
|
|
3872 check_vector_assign (rhs_nr, rhs_nc, ilen, "matrix"); |
|
|
3873 if (error_state) |
|
|
3874 return; |
|
|
3875 |
|
|
3876 force_orient f_orient = no_orient; |
|
|
3877 if (rhs_nr == 1 && rhs_nc != 1) |
|
|
3878 f_orient = row_orient; |
|
|
3879 else if (rhs_nc == 1 && rhs_nr != 1) |
|
|
3880 f_orient = column_orient; |
|
|
3881 |
|
|
3882 maybe_resize (iv.max (), f_orient); |
|
|
3883 if (error_state) |
|
|
3884 return; |
|
|
3885 |
|
|
3886 int nr = rows (); |
|
|
3887 int nc = columns (); |
|
|
3888 |
|
|
3889 if (nr == 1) |
|
|
3890 { |
|
|
3891 for (int i = 0; i < iv.capacity (); i++) |
|
|
3892 REP_ELEM_ASSIGN (0, iv.elem (i), rhs_m.elem (0, i), |
|
|
3893 rhs_cm.elem (0, i), rhs.is_real_type ()); |
|
|
3894 } |
|
|
3895 else if (nc == 1) |
|
|
3896 { |
|
|
3897 for (int i = 0; i < iv.capacity (); i++) |
|
|
3898 REP_ELEM_ASSIGN (iv.elem (i), 0, rhs_m.elem (i, 0), |
|
|
3899 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
3900 } |
|
|
3901 else |
|
|
3902 panic_impossible (); |
|
|
3903 } |
|
|
3904 else |
|
|
3905 panic_impossible (); |
|
|
3906 } |
|
|
3907 |
|
581
|
3908 // Assignment to a vector with a range index. |
|
|
3909 |
|
492
|
3910 void |
|
631
|
3911 TC_REP::do_vector_assign (const tree_constant& rhs, Range& ri) |
|
492
|
3912 { |
|
|
3913 if (rhs.is_zero_by_zero ()) |
|
|
3914 { |
|
|
3915 int nr = rows (); |
|
|
3916 int nc = columns (); |
|
|
3917 |
|
|
3918 int len = MAX (nr, nc); |
|
|
3919 |
|
|
3920 int b = tree_to_mat_idx (ri.min ()); |
|
|
3921 int l = tree_to_mat_idx (ri.max ()); |
|
|
3922 if (b < 0 || l >= len) |
|
|
3923 { |
|
|
3924 ::error ("A(range) = []: index out of range"); |
|
|
3925 return; |
|
|
3926 } |
|
|
3927 |
|
|
3928 if (nr == 1) |
|
|
3929 delete_columns (ri); |
|
|
3930 else if (nc == 1) |
|
|
3931 delete_rows (ri); |
|
|
3932 else |
|
|
3933 panic_impossible (); |
|
|
3934 } |
|
|
3935 else if (rhs.is_scalar_type ()) |
|
|
3936 { |
|
|
3937 int nr = rows (); |
|
|
3938 int nc = columns (); |
|
|
3939 |
|
|
3940 if (nr == 1) |
|
|
3941 { |
|
|
3942 ::error ("A(range) = X: where A is a row vector, X must also be a"); |
|
|
3943 ::error ("row vector with the same number of elements as range"); |
|
|
3944 } |
|
|
3945 else if (nc == 1) |
|
|
3946 { |
|
|
3947 ::error ("A(range) = X: where A is a column vector, X must also be a"); |
|
|
3948 ::error ("column vector with the same number of elements as range"); |
|
|
3949 } |
|
|
3950 else |
|
|
3951 panic_impossible (); |
|
|
3952 } |
|
|
3953 else if (rhs.is_matrix_type ()) |
|
|
3954 { |
|
|
3955 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
3956 |
|
|
3957 int ilen = ri.nelem (); |
|
|
3958 check_vector_assign (rhs_nr, rhs_nc, ilen, "range"); |
|
|
3959 if (error_state) |
|
|
3960 return; |
|
|
3961 |
|
|
3962 force_orient f_orient = no_orient; |
|
|
3963 if (rhs_nr == 1 && rhs_nc != 1) |
|
|
3964 f_orient = row_orient; |
|
|
3965 else if (rhs_nc == 1 && rhs_nr != 1) |
|
|
3966 f_orient = column_orient; |
|
|
3967 |
|
|
3968 maybe_resize (tree_to_mat_idx (ri.max ()), f_orient); |
|
|
3969 if (error_state) |
|
|
3970 return; |
|
|
3971 |
|
|
3972 int nr = rows (); |
|
|
3973 int nc = columns (); |
|
|
3974 |
|
|
3975 double b = ri.base (); |
|
|
3976 double increment = ri.inc (); |
|
|
3977 |
|
|
3978 if (nr == 1) |
|
|
3979 { |
|
|
3980 for (int i = 0; i < ri.nelem (); i++) |
|
|
3981 { |
|
|
3982 double tmp = b + i * increment; |
|
|
3983 int col = tree_to_mat_idx (tmp); |
|
|
3984 REP_ELEM_ASSIGN (0, col, rhs_m.elem (0, i), rhs_cm.elem (0, i), |
|
|
3985 rhs.is_real_type ()); |
|
|
3986 } |
|
|
3987 } |
|
|
3988 else if (nc == 1) |
|
|
3989 { |
|
|
3990 for (int i = 0; i < ri.nelem (); i++) |
|
|
3991 { |
|
|
3992 double tmp = b + i * increment; |
|
|
3993 int row = tree_to_mat_idx (tmp); |
|
|
3994 REP_ELEM_ASSIGN (row, 0, rhs_m.elem (i, 0), rhs_cm.elem (i, 0), |
|
|
3995 rhs.is_real_type ()); |
|
|
3996 } |
|
|
3997 } |
|
|
3998 else |
|
|
3999 panic_impossible (); |
|
|
4000 } |
|
|
4001 else |
|
|
4002 panic_impossible (); |
|
|
4003 } |
|
|
4004 |
|
581
|
4005 // Matrix assignment indexed by two values. This function determines |
|
|
4006 // the type of the first arugment, checks as much as possible, and |
|
|
4007 // then calls one of a set of functions to handle the specific cases: |
|
|
4008 // |
|
|
4009 // M (integer, arg2) = RHS (MA1) |
|
|
4010 // M (vector, arg2) = RHS (MA2) |
|
|
4011 // M (range, arg2) = RHS (MA3) |
|
|
4012 // M (colon, arg2) = RHS (MA4) |
|
|
4013 // |
|
|
4014 // Each of those functions determines the type of the second argument |
|
|
4015 // and calls another function to handle the real work of doing the |
|
|
4016 // assignment. |
|
|
4017 |
|
492
|
4018 void |
|
631
|
4019 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4020 const tree_constant& i_arg, |
|
|
4021 const tree_constant& j_arg) |
|
492
|
4022 { |
|
|
4023 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); |
|
|
4024 |
|
631
|
4025 TC_REP::constant_type itype = tmp_i.const_type (); |
|
492
|
4026 |
|
|
4027 switch (itype) |
|
|
4028 { |
|
|
4029 case complex_scalar_constant: |
|
|
4030 case scalar_constant: |
|
|
4031 { |
|
|
4032 int i = tree_to_mat_idx (tmp_i.double_value ()); |
|
|
4033 if (index_check (i, "row") < 0) |
|
|
4034 return; |
|
|
4035 do_matrix_assignment (rhs, i, j_arg); |
|
|
4036 } |
|
|
4037 break; |
|
631
|
4038 |
|
492
|
4039 case complex_matrix_constant: |
|
|
4040 case matrix_constant: |
|
|
4041 { |
|
|
4042 Matrix mi = tmp_i.matrix_value (); |
|
|
4043 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); |
|
|
4044 if (! iv) |
|
|
4045 return; |
|
|
4046 |
|
|
4047 do_matrix_assignment (rhs, iv, j_arg); |
|
|
4048 } |
|
|
4049 break; |
|
631
|
4050 |
|
492
|
4051 case string_constant: |
|
|
4052 gripe_string_invalid (); |
|
|
4053 break; |
|
631
|
4054 |
|
492
|
4055 case range_constant: |
|
|
4056 { |
|
|
4057 Range ri = tmp_i.range_value (); |
|
|
4058 int nr = rows (); |
|
|
4059 if (nr == 2 && is_zero_one (ri)) |
|
|
4060 { |
|
|
4061 do_matrix_assignment (rhs, 1, j_arg); |
|
|
4062 } |
|
|
4063 else if (nr == 2 && is_one_zero (ri)) |
|
|
4064 { |
|
|
4065 do_matrix_assignment (rhs, 0, j_arg); |
|
|
4066 } |
|
|
4067 else |
|
|
4068 { |
|
|
4069 if (index_check (ri, "row") < 0) |
|
|
4070 return; |
|
|
4071 do_matrix_assignment (rhs, ri, j_arg); |
|
|
4072 } |
|
|
4073 } |
|
|
4074 break; |
|
631
|
4075 |
|
492
|
4076 case magic_colon: |
|
|
4077 do_matrix_assignment (rhs, magic_colon, j_arg); |
|
|
4078 break; |
|
631
|
4079 |
|
492
|
4080 default: |
|
|
4081 panic_impossible (); |
|
|
4082 break; |
|
|
4083 } |
|
|
4084 } |
|
|
4085 |
|
|
4086 /* MA1 */ |
|
|
4087 void |
|
631
|
4088 TC_REP::do_matrix_assignment (const tree_constant& rhs, int i, |
|
|
4089 const tree_constant& j_arg) |
|
492
|
4090 { |
|
|
4091 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
4092 |
|
631
|
4093 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
492
|
4094 |
|
|
4095 int rhs_nr = rhs.rows (); |
|
|
4096 int rhs_nc = rhs.columns (); |
|
|
4097 |
|
|
4098 switch (jtype) |
|
|
4099 { |
|
|
4100 case complex_scalar_constant: |
|
|
4101 case scalar_constant: |
|
|
4102 { |
|
|
4103 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
4104 if (index_check (j, "column") < 0) |
|
|
4105 return; |
|
|
4106 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) |
|
|
4107 { |
|
|
4108 ::error ("A(int,int) = X, X must be a scalar"); |
|
|
4109 return; |
|
|
4110 } |
|
|
4111 maybe_resize (i, j); |
|
|
4112 if (error_state) |
|
|
4113 return; |
|
|
4114 |
|
|
4115 do_matrix_assignment (rhs, i, j); |
|
|
4116 } |
|
|
4117 break; |
|
631
|
4118 |
|
492
|
4119 case complex_matrix_constant: |
|
|
4120 case matrix_constant: |
|
|
4121 { |
|
|
4122 Matrix mj = tmp_j.matrix_value (); |
|
|
4123 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
4124 columns ()); |
|
|
4125 if (! jv) |
|
|
4126 return; |
|
|
4127 |
|
|
4128 if (! indexed_assign_conforms (1, jv.capacity (), rhs_nr, rhs_nc)) |
|
|
4129 { |
|
|
4130 ::error ("A(int,matrix) = X: X must be a row vector with the same"); |
|
|
4131 ::error ("number of elements as matrix"); |
|
|
4132 return; |
|
|
4133 } |
|
|
4134 maybe_resize (i, jv.max ()); |
|
|
4135 if (error_state) |
|
|
4136 return; |
|
|
4137 |
|
|
4138 do_matrix_assignment (rhs, i, jv); |
|
|
4139 } |
|
|
4140 break; |
|
631
|
4141 |
|
492
|
4142 case string_constant: |
|
|
4143 gripe_string_invalid (); |
|
|
4144 break; |
|
631
|
4145 |
|
492
|
4146 case range_constant: |
|
|
4147 { |
|
|
4148 Range rj = tmp_j.range_value (); |
|
|
4149 if (! indexed_assign_conforms (1, rj.nelem (), rhs_nr, rhs_nc)) |
|
|
4150 { |
|
|
4151 ::error ("A(int,range) = X: X must be a row vector with the same"); |
|
|
4152 ::error ("number of elements as range"); |
|
|
4153 return; |
|
|
4154 } |
|
|
4155 |
|
|
4156 int nc = columns (); |
|
|
4157 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
4158 { |
|
|
4159 do_matrix_assignment (rhs, i, 1); |
|
|
4160 } |
|
|
4161 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
4162 { |
|
|
4163 do_matrix_assignment (rhs, i, 0); |
|
|
4164 } |
|
|
4165 else |
|
|
4166 { |
|
|
4167 if (index_check (rj, "column") < 0) |
|
|
4168 return; |
|
|
4169 maybe_resize (i, tree_to_mat_idx (rj.max ())); |
|
|
4170 if (error_state) |
|
|
4171 return; |
|
|
4172 |
|
|
4173 do_matrix_assignment (rhs, i, rj); |
|
|
4174 } |
|
|
4175 } |
|
|
4176 break; |
|
631
|
4177 |
|
492
|
4178 case magic_colon: |
|
|
4179 { |
|
|
4180 int nc = columns (); |
|
|
4181 int nr = rows (); |
|
|
4182 if (nc == 0 && nr == 0 && rhs_nr == 1) |
|
|
4183 { |
|
|
4184 if (rhs.is_complex_type ()) |
|
|
4185 { |
|
|
4186 complex_matrix = new ComplexMatrix (); |
|
|
4187 type_tag = complex_matrix_constant; |
|
|
4188 } |
|
|
4189 else |
|
|
4190 { |
|
|
4191 matrix = new Matrix (); |
|
|
4192 type_tag = matrix_constant; |
|
|
4193 } |
|
|
4194 maybe_resize (i, rhs_nc-1); |
|
|
4195 if (error_state) |
|
|
4196 return; |
|
|
4197 } |
|
|
4198 else if (indexed_assign_conforms (1, nc, rhs_nr, rhs_nc)) |
|
|
4199 { |
|
|
4200 maybe_resize (i, nc-1); |
|
|
4201 if (error_state) |
|
|
4202 return; |
|
|
4203 } |
|
|
4204 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4205 { |
|
|
4206 if (i < 0 || i >= nr) |
|
|
4207 { |
|
|
4208 ::error ("A(int,:) = []: row index out of range"); |
|
|
4209 return; |
|
|
4210 } |
|
|
4211 } |
|
|
4212 else |
|
|
4213 { |
|
|
4214 ::error ("A(int,:) = X: X must be a row vector with the same"); |
|
|
4215 ::error ("number of columns as A"); |
|
|
4216 return; |
|
|
4217 } |
|
|
4218 |
|
|
4219 do_matrix_assignment (rhs, i, magic_colon); |
|
|
4220 } |
|
|
4221 break; |
|
|
4222 default: |
|
|
4223 panic_impossible (); |
|
|
4224 break; |
|
|
4225 } |
|
|
4226 } |
|
|
4227 |
|
|
4228 /* MA2 */ |
|
|
4229 void |
|
631
|
4230 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4231 idx_vector& iv, const tree_constant& j_arg) |
|
492
|
4232 { |
|
|
4233 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
4234 |
|
631
|
4235 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
492
|
4236 |
|
|
4237 int rhs_nr = rhs.rows (); |
|
|
4238 int rhs_nc = rhs.columns (); |
|
|
4239 |
|
|
4240 switch (jtype) |
|
|
4241 { |
|
|
4242 case complex_scalar_constant: |
|
|
4243 case scalar_constant: |
|
|
4244 { |
|
|
4245 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
4246 if (index_check (j, "column") < 0) |
|
|
4247 return; |
|
|
4248 if (! indexed_assign_conforms (iv.capacity (), 1, rhs_nr, rhs_nc)) |
|
|
4249 { |
|
|
4250 ::error ("A(matrix,int) = X: X must be a column vector with the"); |
|
|
4251 ::error ("same number of elements as matrix"); |
|
|
4252 return; |
|
|
4253 } |
|
|
4254 maybe_resize (iv.max (), j); |
|
|
4255 if (error_state) |
|
|
4256 return; |
|
|
4257 |
|
|
4258 do_matrix_assignment (rhs, iv, j); |
|
|
4259 } |
|
|
4260 break; |
|
631
|
4261 |
|
492
|
4262 case complex_matrix_constant: |
|
|
4263 case matrix_constant: |
|
|
4264 { |
|
|
4265 Matrix mj = tmp_j.matrix_value (); |
|
|
4266 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
4267 columns ()); |
|
|
4268 if (! jv) |
|
|
4269 return; |
|
|
4270 |
|
|
4271 if (! indexed_assign_conforms (iv.capacity (), jv.capacity (), |
|
|
4272 rhs_nr, rhs_nc)) |
|
|
4273 { |
|
|
4274 ::error ("A(r_mat,c_mat) = X: the number of rows in X must match"); |
|
|
4275 ::error ("the number of elements in r_mat and the number of"); |
|
|
4276 ::error ("columns in X must match the number of elements in c_mat"); |
|
|
4277 return; |
|
|
4278 } |
|
|
4279 maybe_resize (iv.max (), jv.max ()); |
|
|
4280 if (error_state) |
|
|
4281 return; |
|
|
4282 |
|
|
4283 do_matrix_assignment (rhs, iv, jv); |
|
|
4284 } |
|
|
4285 break; |
|
631
|
4286 |
|
492
|
4287 case string_constant: |
|
|
4288 gripe_string_invalid (); |
|
|
4289 break; |
|
631
|
4290 |
|
492
|
4291 case range_constant: |
|
|
4292 { |
|
|
4293 Range rj = tmp_j.range_value (); |
|
|
4294 if (! indexed_assign_conforms (iv.capacity (), rj.nelem (), |
|
|
4295 rhs_nr, rhs_nc)) |
|
|
4296 { |
|
|
4297 ::error ("A(matrix,range) = X: the number of rows in X must match"); |
|
|
4298 ::error ("the number of elements in matrix and the number of"); |
|
|
4299 ::error ("columns in X must match the number of elements in range"); |
|
|
4300 return; |
|
|
4301 } |
|
|
4302 |
|
|
4303 int nc = columns (); |
|
|
4304 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
4305 { |
|
|
4306 do_matrix_assignment (rhs, iv, 1); |
|
|
4307 } |
|
|
4308 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
4309 { |
|
|
4310 do_matrix_assignment (rhs, iv, 0); |
|
|
4311 } |
|
|
4312 else |
|
|
4313 { |
|
|
4314 if (index_check (rj, "column") < 0) |
|
|
4315 return; |
|
|
4316 maybe_resize (iv.max (), tree_to_mat_idx (rj.max ())); |
|
|
4317 if (error_state) |
|
|
4318 return; |
|
|
4319 |
|
|
4320 do_matrix_assignment (rhs, iv, rj); |
|
|
4321 } |
|
|
4322 } |
|
|
4323 break; |
|
631
|
4324 |
|
492
|
4325 case magic_colon: |
|
|
4326 { |
|
|
4327 int nc = columns (); |
|
|
4328 int new_nc = nc; |
|
|
4329 if (nc == 0) |
|
|
4330 new_nc = rhs_nc; |
|
|
4331 |
|
|
4332 if (indexed_assign_conforms (iv.capacity (), new_nc, |
|
|
4333 rhs_nr, rhs_nc)) |
|
|
4334 { |
|
|
4335 maybe_resize (iv.max (), new_nc-1); |
|
|
4336 if (error_state) |
|
|
4337 return; |
|
|
4338 } |
|
|
4339 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4340 { |
|
|
4341 if (iv.max () >= rows ()) |
|
|
4342 { |
|
|
4343 ::error ("A(matrix,:) = []: row index out of range"); |
|
|
4344 return; |
|
|
4345 } |
|
|
4346 } |
|
|
4347 else |
|
|
4348 { |
|
|
4349 ::error ("A(matrix,:) = X: the number of rows in X must match the"); |
|
|
4350 ::error ("number of elements in matrix, and the number of columns"); |
|
|
4351 ::error ("in X must match the number of columns in A"); |
|
|
4352 return; |
|
|
4353 } |
|
|
4354 |
|
|
4355 do_matrix_assignment (rhs, iv, magic_colon); |
|
|
4356 } |
|
|
4357 break; |
|
|
4358 default: |
|
|
4359 panic_impossible (); |
|
|
4360 break; |
|
|
4361 } |
|
|
4362 } |
|
|
4363 |
|
|
4364 /* MA3 */ |
|
|
4365 void |
|
631
|
4366 TC_REP::do_matrix_assignment (const tree_constant& rhs, Range& ri, |
|
|
4367 const tree_constant& j_arg) |
|
492
|
4368 { |
|
|
4369 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
4370 |
|
631
|
4371 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
492
|
4372 |
|
|
4373 int rhs_nr = rhs.rows (); |
|
|
4374 int rhs_nc = rhs.columns (); |
|
|
4375 |
|
|
4376 switch (jtype) |
|
|
4377 { |
|
|
4378 case complex_scalar_constant: |
|
|
4379 case scalar_constant: |
|
|
4380 { |
|
|
4381 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
4382 if (index_check (j, "column") < 0) |
|
|
4383 return; |
|
|
4384 if (! indexed_assign_conforms (ri.nelem (), 1, rhs_nr, rhs_nc)) |
|
|
4385 { |
|
|
4386 ::error ("A(range,int) = X: X must be a column vector with the"); |
|
|
4387 ::error ("same number of elements as range"); |
|
|
4388 return; |
|
|
4389 } |
|
|
4390 maybe_resize (tree_to_mat_idx (ri.max ()), j); |
|
|
4391 if (error_state) |
|
|
4392 return; |
|
|
4393 |
|
|
4394 do_matrix_assignment (rhs, ri, j); |
|
|
4395 } |
|
|
4396 break; |
|
631
|
4397 |
|
492
|
4398 case complex_matrix_constant: |
|
|
4399 case matrix_constant: |
|
|
4400 { |
|
|
4401 Matrix mj = tmp_j.matrix_value (); |
|
|
4402 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
4403 columns ()); |
|
|
4404 if (! jv) |
|
|
4405 return; |
|
|
4406 |
|
|
4407 if (! indexed_assign_conforms (ri.nelem (), jv.capacity (), |
|
|
4408 rhs_nr, rhs_nc)) |
|
|
4409 { |
|
|
4410 ::error ("A(range,matrix) = X: the number of rows in X must match"); |
|
|
4411 ::error ("the number of elements in range and the number of"); |
|
|
4412 ::error ("columns in X must match the number of elements in matrix"); |
|
|
4413 return; |
|
|
4414 } |
|
|
4415 maybe_resize (tree_to_mat_idx (ri.max ()), jv.max ()); |
|
|
4416 if (error_state) |
|
|
4417 return; |
|
|
4418 |
|
|
4419 do_matrix_assignment (rhs, ri, jv); |
|
|
4420 } |
|
|
4421 break; |
|
631
|
4422 |
|
492
|
4423 case string_constant: |
|
|
4424 gripe_string_invalid (); |
|
|
4425 break; |
|
631
|
4426 |
|
492
|
4427 case range_constant: |
|
|
4428 { |
|
|
4429 Range rj = tmp_j.range_value (); |
|
|
4430 if (! indexed_assign_conforms (ri.nelem (), rj.nelem (), |
|
|
4431 rhs_nr, rhs_nc)) |
|
|
4432 { |
|
|
4433 ::error ("A(r_range,c_range) = X: the number of rows in X must"); |
|
|
4434 ::error ("match the number of elements in r_range and the number"); |
|
|
4435 ::error ("of columns in X must match the number of elements in"); |
|
|
4436 ::error ("c_range"); |
|
|
4437 return; |
|
|
4438 } |
|
|
4439 |
|
|
4440 int nc = columns (); |
|
|
4441 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
4442 { |
|
|
4443 do_matrix_assignment (rhs, ri, 1); |
|
|
4444 } |
|
|
4445 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
4446 { |
|
|
4447 do_matrix_assignment (rhs, ri, 0); |
|
|
4448 } |
|
|
4449 else |
|
|
4450 { |
|
|
4451 if (index_check (rj, "column") < 0) |
|
|
4452 return; |
|
|
4453 |
|
|
4454 maybe_resize (tree_to_mat_idx (ri.max ()), |
|
|
4455 tree_to_mat_idx (rj.max ())); |
|
|
4456 |
|
|
4457 if (error_state) |
|
|
4458 return; |
|
|
4459 |
|
|
4460 do_matrix_assignment (rhs, ri, rj); |
|
|
4461 } |
|
|
4462 } |
|
|
4463 break; |
|
631
|
4464 |
|
492
|
4465 case magic_colon: |
|
|
4466 { |
|
|
4467 int nc = columns (); |
|
|
4468 int new_nc = nc; |
|
|
4469 if (nc == 0) |
|
|
4470 new_nc = rhs_nc; |
|
|
4471 |
|
|
4472 if (indexed_assign_conforms (ri.nelem (), new_nc, rhs_nr, rhs_nc)) |
|
|
4473 { |
|
|
4474 maybe_resize (tree_to_mat_idx (ri.max ()), new_nc-1); |
|
|
4475 if (error_state) |
|
|
4476 return; |
|
|
4477 } |
|
|
4478 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4479 { |
|
|
4480 int b = tree_to_mat_idx (ri.min ()); |
|
|
4481 int l = tree_to_mat_idx (ri.max ()); |
|
|
4482 if (b < 0 || l >= rows ()) |
|
|
4483 { |
|
|
4484 ::error ("A(range,:) = []: row index out of range"); |
|
|
4485 return; |
|
|
4486 } |
|
|
4487 } |
|
|
4488 else |
|
|
4489 { |
|
|
4490 ::error ("A(range,:) = X: the number of rows in X must match the"); |
|
|
4491 ::error ("number of elements in range, and the number of columns"); |
|
|
4492 ::error ("in X must match the number of columns in A"); |
|
|
4493 return; |
|
|
4494 } |
|
|
4495 |
|
|
4496 do_matrix_assignment (rhs, ri, magic_colon); |
|
|
4497 } |
|
|
4498 break; |
|
|
4499 default: |
|
|
4500 panic_impossible (); |
|
|
4501 break; |
|
|
4502 } |
|
|
4503 } |
|
|
4504 |
|
|
4505 /* MA4 */ |
|
|
4506 void |
|
631
|
4507 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4508 TC_REP::constant_type i, |
|
|
4509 const tree_constant& j_arg) |
|
492
|
4510 { |
|
|
4511 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); |
|
|
4512 |
|
631
|
4513 TC_REP::constant_type jtype = tmp_j.const_type (); |
|
492
|
4514 |
|
|
4515 int rhs_nr = rhs.rows (); |
|
|
4516 int rhs_nc = rhs.columns (); |
|
|
4517 |
|
|
4518 switch (jtype) |
|
|
4519 { |
|
|
4520 case complex_scalar_constant: |
|
|
4521 case scalar_constant: |
|
|
4522 { |
|
|
4523 int j = tree_to_mat_idx (tmp_j.double_value ()); |
|
|
4524 if (index_check (j, "column") < 0) |
|
|
4525 return; |
|
|
4526 int nr = rows (); |
|
|
4527 int nc = columns (); |
|
|
4528 if (nr == 0 && nc == 0 && rhs_nc == 1) |
|
|
4529 { |
|
|
4530 if (rhs.is_complex_type ()) |
|
|
4531 { |
|
|
4532 complex_matrix = new ComplexMatrix (); |
|
|
4533 type_tag = complex_matrix_constant; |
|
|
4534 } |
|
|
4535 else |
|
|
4536 { |
|
|
4537 matrix = new Matrix (); |
|
|
4538 type_tag = matrix_constant; |
|
|
4539 } |
|
|
4540 maybe_resize (rhs_nr-1, j); |
|
|
4541 if (error_state) |
|
|
4542 return; |
|
|
4543 } |
|
|
4544 else if (indexed_assign_conforms (nr, 1, rhs_nr, rhs_nc)) |
|
|
4545 { |
|
|
4546 maybe_resize (nr-1, j); |
|
|
4547 if (error_state) |
|
|
4548 return; |
|
|
4549 } |
|
|
4550 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4551 { |
|
|
4552 if (j < 0 || j >= nc) |
|
|
4553 { |
|
|
4554 ::error ("A(:,int) = []: column index out of range"); |
|
|
4555 return; |
|
|
4556 } |
|
|
4557 } |
|
|
4558 else |
|
|
4559 { |
|
|
4560 ::error ("A(:,int) = X: X must be a column vector with the same"); |
|
|
4561 ::error ("number of rows as A"); |
|
|
4562 return; |
|
|
4563 } |
|
|
4564 |
|
|
4565 do_matrix_assignment (rhs, magic_colon, j); |
|
|
4566 } |
|
|
4567 break; |
|
631
|
4568 |
|
492
|
4569 case complex_matrix_constant: |
|
|
4570 case matrix_constant: |
|
|
4571 { |
|
|
4572 Matrix mj = tmp_j.matrix_value (); |
|
|
4573 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", |
|
|
4574 columns ()); |
|
|
4575 if (! jv) |
|
|
4576 return; |
|
|
4577 |
|
|
4578 int nr = rows (); |
|
|
4579 int new_nr = nr; |
|
|
4580 if (nr == 0) |
|
|
4581 new_nr = rhs_nr; |
|
|
4582 |
|
|
4583 if (indexed_assign_conforms (new_nr, jv.capacity (), |
|
|
4584 rhs_nr, rhs_nc)) |
|
|
4585 { |
|
|
4586 maybe_resize (new_nr-1, jv.max ()); |
|
|
4587 if (error_state) |
|
|
4588 return; |
|
|
4589 } |
|
|
4590 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4591 { |
|
|
4592 if (jv.max () >= columns ()) |
|
|
4593 { |
|
|
4594 ::error ("A(:,matrix) = []: column index out of range"); |
|
|
4595 return; |
|
|
4596 } |
|
|
4597 } |
|
|
4598 else |
|
|
4599 { |
|
|
4600 ::error ("A(:,matrix) = X: the number of rows in X must match the"); |
|
|
4601 ::error ("number of rows in A, and the number of columns in X must"); |
|
|
4602 ::error ("match the number of elements in matrix"); |
|
|
4603 return; |
|
|
4604 } |
|
|
4605 |
|
|
4606 do_matrix_assignment (rhs, magic_colon, jv); |
|
|
4607 } |
|
|
4608 break; |
|
631
|
4609 |
|
492
|
4610 case string_constant: |
|
|
4611 gripe_string_invalid (); |
|
|
4612 break; |
|
631
|
4613 |
|
492
|
4614 case range_constant: |
|
|
4615 { |
|
|
4616 Range rj = tmp_j.range_value (); |
|
|
4617 int nr = rows (); |
|
|
4618 int new_nr = nr; |
|
|
4619 if (nr == 0) |
|
|
4620 new_nr = rhs_nr; |
|
|
4621 |
|
|
4622 if (indexed_assign_conforms (new_nr, rj.nelem (), rhs_nr, rhs_nc)) |
|
|
4623 { |
|
|
4624 int nc = columns (); |
|
|
4625 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) |
|
|
4626 { |
|
|
4627 do_matrix_assignment (rhs, magic_colon, 1); |
|
|
4628 } |
|
|
4629 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) |
|
|
4630 { |
|
|
4631 do_matrix_assignment (rhs, magic_colon, 0); |
|
|
4632 } |
|
|
4633 else |
|
|
4634 { |
|
|
4635 if (index_check (rj, "column") < 0) |
|
|
4636 return; |
|
|
4637 maybe_resize (new_nr-1, tree_to_mat_idx (rj.max ())); |
|
|
4638 if (error_state) |
|
|
4639 return; |
|
|
4640 } |
|
|
4641 } |
|
|
4642 else if (rhs_nr == 0 && rhs_nc == 0) |
|
|
4643 { |
|
|
4644 int b = tree_to_mat_idx (rj.min ()); |
|
|
4645 int l = tree_to_mat_idx (rj.max ()); |
|
|
4646 if (b < 0 || l >= columns ()) |
|
|
4647 { |
|
|
4648 ::error ("A(:,range) = []: column index out of range"); |
|
|
4649 return; |
|
|
4650 } |
|
|
4651 } |
|
|
4652 else |
|
|
4653 { |
|
|
4654 ::error ("A(:,range) = X: the number of rows in X must match the"); |
|
|
4655 ::error ("number of rows in A, and the number of columns in X"); |
|
|
4656 ::error ("must match the number of elements in range"); |
|
|
4657 return; |
|
|
4658 } |
|
|
4659 |
|
|
4660 do_matrix_assignment (rhs, magic_colon, rj); |
|
|
4661 } |
|
|
4662 break; |
|
631
|
4663 |
|
492
|
4664 case magic_colon: |
|
|
4665 // a(:,:) = foo is equivalent to a = foo. |
|
|
4666 do_matrix_assignment (rhs, magic_colon, magic_colon); |
|
|
4667 break; |
|
631
|
4668 |
|
492
|
4669 default: |
|
|
4670 panic_impossible (); |
|
|
4671 break; |
|
|
4672 } |
|
|
4673 } |
|
|
4674 |
|
581
|
4675 // Functions that actually handle assignment to a matrix using two |
|
|
4676 // index values. |
|
|
4677 // |
|
|
4678 // idx2 |
|
|
4679 // +---+---+----+----+ |
|
|
4680 // idx1 | i | v | r | c | |
|
|
4681 // ---------+---+---+----+----+ |
|
|
4682 // integer | 1 | 5 | 9 | 13 | |
|
|
4683 // ---------+---+---+----+----+ |
|
|
4684 // vector | 2 | 6 | 10 | 14 | |
|
|
4685 // ---------+---+---+----+----+ |
|
|
4686 // range | 3 | 7 | 11 | 15 | |
|
|
4687 // ---------+---+---+----+----+ |
|
|
4688 // colon | 4 | 8 | 12 | 16 | |
|
|
4689 // ---------+---+---+----+----+ |
|
492
|
4690 |
|
|
4691 /* 1 */ |
|
|
4692 void |
|
631
|
4693 TC_REP::do_matrix_assignment (const tree_constant& rhs, int i, int j) |
|
492
|
4694 { |
|
|
4695 REP_ELEM_ASSIGN (i, j, rhs.double_value (), rhs.complex_value (), |
|
|
4696 rhs.is_real_type ()); |
|
|
4697 } |
|
|
4698 |
|
|
4699 /* 2 */ |
|
|
4700 void |
|
631
|
4701 TC_REP::do_matrix_assignment (const tree_constant& rhs, int i, idx_vector& jv) |
|
492
|
4702 { |
|
|
4703 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4704 |
|
|
4705 for (int j = 0; j < jv.capacity (); j++) |
|
|
4706 REP_ELEM_ASSIGN (i, jv.elem (j), rhs_m.elem (0, j), |
|
|
4707 rhs_cm.elem (0, j), rhs.is_real_type ()); |
|
|
4708 } |
|
|
4709 |
|
|
4710 /* 3 */ |
|
|
4711 void |
|
631
|
4712 TC_REP::do_matrix_assignment (const tree_constant& rhs, int i, Range& rj) |
|
492
|
4713 { |
|
|
4714 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4715 |
|
|
4716 double b = rj.base (); |
|
|
4717 double increment = rj.inc (); |
|
|
4718 |
|
|
4719 for (int j = 0; j < rj.nelem (); j++) |
|
|
4720 { |
|
|
4721 double tmp = b + j * increment; |
|
|
4722 int col = tree_to_mat_idx (tmp); |
|
|
4723 REP_ELEM_ASSIGN (i, col, rhs_m.elem (0, j), rhs_cm.elem (0, j), |
|
|
4724 rhs.is_real_type ()); |
|
|
4725 } |
|
|
4726 } |
|
|
4727 |
|
|
4728 /* 4 */ |
|
|
4729 void |
|
631
|
4730 TC_REP::do_matrix_assignment (const tree_constant& rhs, int i, |
|
|
4731 TC_REP::constant_type mcj) |
|
492
|
4732 { |
|
|
4733 assert (mcj == magic_colon); |
|
|
4734 |
|
|
4735 int nc = columns (); |
|
|
4736 |
|
|
4737 if (rhs.is_zero_by_zero ()) |
|
|
4738 { |
|
|
4739 delete_row (i); |
|
|
4740 } |
|
|
4741 else if (rhs.is_matrix_type ()) |
|
|
4742 { |
|
|
4743 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4744 |
|
|
4745 for (int j = 0; j < nc; j++) |
|
|
4746 REP_ELEM_ASSIGN (i, j, rhs_m.elem (0, j), rhs_cm.elem (0, j), |
|
|
4747 rhs.is_real_type ()); |
|
|
4748 } |
|
|
4749 else if (rhs.is_scalar_type () && nc == 1) |
|
|
4750 { |
|
|
4751 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), |
|
|
4752 rhs.complex_value (), rhs.is_real_type ()); |
|
|
4753 } |
|
|
4754 else |
|
|
4755 panic_impossible (); |
|
|
4756 } |
|
|
4757 |
|
|
4758 /* 5 */ |
|
|
4759 void |
|
631
|
4760 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4761 idx_vector& iv, int j) |
|
492
|
4762 { |
|
|
4763 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4764 |
|
|
4765 for (int i = 0; i < iv.capacity (); i++) |
|
|
4766 { |
|
|
4767 int row = iv.elem (i); |
|
|
4768 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), |
|
|
4769 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4770 } |
|
|
4771 } |
|
|
4772 |
|
|
4773 /* 6 */ |
|
|
4774 void |
|
631
|
4775 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4776 idx_vector& iv, idx_vector& jv) |
|
492
|
4777 { |
|
|
4778 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4779 |
|
|
4780 for (int i = 0; i < iv.capacity (); i++) |
|
|
4781 { |
|
|
4782 int row = iv.elem (i); |
|
|
4783 for (int j = 0; j < jv.capacity (); j++) |
|
|
4784 { |
|
|
4785 int col = jv.elem (j); |
|
|
4786 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4787 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4788 } |
|
|
4789 } |
|
|
4790 } |
|
|
4791 |
|
|
4792 /* 7 */ |
|
|
4793 void |
|
631
|
4794 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4795 idx_vector& iv, Range& rj) |
|
492
|
4796 { |
|
|
4797 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4798 |
|
|
4799 double b = rj.base (); |
|
|
4800 double increment = rj.inc (); |
|
|
4801 |
|
|
4802 for (int i = 0; i < iv.capacity (); i++) |
|
|
4803 { |
|
|
4804 int row = iv.elem (i); |
|
|
4805 for (int j = 0; j < rj.nelem (); j++) |
|
|
4806 { |
|
|
4807 double tmp = b + j * increment; |
|
|
4808 int col = tree_to_mat_idx (tmp); |
|
|
4809 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4810 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4811 } |
|
|
4812 } |
|
|
4813 } |
|
|
4814 |
|
|
4815 /* 8 */ |
|
|
4816 void |
|
631
|
4817 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4818 idx_vector& iv, TC_REP::constant_type mcj) |
|
492
|
4819 { |
|
|
4820 assert (mcj == magic_colon); |
|
|
4821 |
|
|
4822 if (rhs.is_zero_by_zero ()) |
|
|
4823 { |
|
|
4824 delete_rows (iv); |
|
|
4825 } |
|
|
4826 else |
|
|
4827 { |
|
|
4828 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4829 |
|
|
4830 int nc = columns (); |
|
|
4831 |
|
|
4832 for (int j = 0; j < nc; j++) |
|
|
4833 { |
|
|
4834 for (int i = 0; i < iv.capacity (); i++) |
|
|
4835 { |
|
|
4836 int row = iv.elem (i); |
|
|
4837 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), |
|
|
4838 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4839 } |
|
|
4840 } |
|
|
4841 } |
|
|
4842 } |
|
|
4843 |
|
|
4844 /* 9 */ |
|
|
4845 void |
|
631
|
4846 TC_REP::do_matrix_assignment (const tree_constant& rhs, Range& ri, int j) |
|
492
|
4847 { |
|
|
4848 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4849 |
|
|
4850 double b = ri.base (); |
|
|
4851 double increment = ri.inc (); |
|
|
4852 |
|
|
4853 for (int i = 0; i < ri.nelem (); i++) |
|
|
4854 { |
|
|
4855 double tmp = b + i * increment; |
|
|
4856 int row = tree_to_mat_idx (tmp); |
|
|
4857 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), |
|
|
4858 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4859 } |
|
|
4860 } |
|
|
4861 |
|
|
4862 /* 10 */ |
|
|
4863 void |
|
631
|
4864 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4865 Range& ri, idx_vector& jv) |
|
492
|
4866 { |
|
|
4867 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4868 |
|
|
4869 double b = ri.base (); |
|
|
4870 double increment = ri.inc (); |
|
|
4871 |
|
|
4872 for (int j = 0; j < jv.capacity (); j++) |
|
|
4873 { |
|
|
4874 int col = jv.elem (j); |
|
|
4875 for (int i = 0; i < ri.nelem (); i++) |
|
|
4876 { |
|
|
4877 double tmp = b + i * increment; |
|
|
4878 int row = tree_to_mat_idx (tmp); |
|
|
4879 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4880 rhs_m.elem (i, j), rhs.is_real_type ()); |
|
|
4881 } |
|
|
4882 } |
|
|
4883 } |
|
|
4884 |
|
|
4885 /* 11 */ |
|
|
4886 void |
|
631
|
4887 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4888 Range& ri, Range& rj) |
|
492
|
4889 { |
|
|
4890 double ib = ri.base (); |
|
|
4891 double iinc = ri.inc (); |
|
|
4892 double jb = rj.base (); |
|
|
4893 double jinc = rj.inc (); |
|
|
4894 |
|
|
4895 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4896 |
|
|
4897 for (int i = 0; i < ri.nelem (); i++) |
|
|
4898 { |
|
|
4899 double itmp = ib + i * iinc; |
|
|
4900 int row = tree_to_mat_idx (itmp); |
|
|
4901 for (int j = 0; j < rj.nelem (); j++) |
|
|
4902 { |
|
|
4903 double jtmp = jb + j * jinc; |
|
|
4904 int col = tree_to_mat_idx (jtmp); |
|
|
4905 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), |
|
|
4906 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4907 } |
|
|
4908 } |
|
|
4909 } |
|
|
4910 |
|
|
4911 /* 12 */ |
|
|
4912 void |
|
631
|
4913 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4914 Range& ri, TC_REP::constant_type mcj) |
|
492
|
4915 { |
|
|
4916 assert (mcj == magic_colon); |
|
|
4917 |
|
|
4918 if (rhs.is_zero_by_zero ()) |
|
|
4919 { |
|
|
4920 delete_rows (ri); |
|
|
4921 } |
|
|
4922 else |
|
|
4923 { |
|
|
4924 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4925 |
|
|
4926 double ib = ri.base (); |
|
|
4927 double iinc = ri.inc (); |
|
|
4928 |
|
|
4929 int nc = columns (); |
|
|
4930 |
|
|
4931 for (int i = 0; i < ri.nelem (); i++) |
|
|
4932 { |
|
|
4933 double itmp = ib + i * iinc; |
|
|
4934 int row = tree_to_mat_idx (itmp); |
|
|
4935 for (int j = 0; j < nc; j++) |
|
|
4936 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), |
|
|
4937 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4938 } |
|
|
4939 } |
|
|
4940 } |
|
|
4941 |
|
|
4942 /* 13 */ |
|
|
4943 void |
|
631
|
4944 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4945 TC_REP::constant_type mci, int j) |
|
492
|
4946 { |
|
|
4947 assert (mci == magic_colon); |
|
|
4948 |
|
|
4949 int nr = rows (); |
|
|
4950 |
|
|
4951 if (rhs.is_zero_by_zero ()) |
|
|
4952 { |
|
|
4953 delete_column (j); |
|
|
4954 } |
|
|
4955 else if (rhs.is_matrix_type ()) |
|
|
4956 { |
|
|
4957 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4958 |
|
|
4959 for (int i = 0; i < nr; i++) |
|
|
4960 REP_ELEM_ASSIGN (i, j, rhs_m.elem (i, 0), |
|
|
4961 rhs_cm.elem (i, 0), rhs.is_real_type ()); |
|
|
4962 } |
|
|
4963 else if (rhs.is_scalar_type () && nr == 1) |
|
|
4964 { |
|
|
4965 REP_ELEM_ASSIGN (0, j, rhs.double_value (), |
|
|
4966 rhs.complex_value (), rhs.is_real_type ()); |
|
|
4967 } |
|
|
4968 else |
|
|
4969 panic_impossible (); |
|
|
4970 } |
|
|
4971 |
|
|
4972 /* 14 */ |
|
|
4973 void |
|
631
|
4974 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
4975 TC_REP::constant_type mci, idx_vector& jv) |
|
492
|
4976 { |
|
|
4977 assert (mci == magic_colon); |
|
|
4978 |
|
|
4979 if (rhs.is_zero_by_zero ()) |
|
|
4980 { |
|
|
4981 delete_columns (jv); |
|
|
4982 } |
|
|
4983 else |
|
|
4984 { |
|
|
4985 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
4986 |
|
|
4987 int nr = rows (); |
|
|
4988 |
|
|
4989 for (int i = 0; i < nr; i++) |
|
|
4990 { |
|
|
4991 for (int j = 0; j < jv.capacity (); j++) |
|
|
4992 { |
|
|
4993 int col = jv.elem (j); |
|
|
4994 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), |
|
|
4995 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
4996 } |
|
|
4997 } |
|
|
4998 } |
|
|
4999 } |
|
|
5000 |
|
|
5001 /* 15 */ |
|
|
5002 void |
|
631
|
5003 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
5004 TC_REP::constant_type mci, Range& rj) |
|
492
|
5005 { |
|
|
5006 assert (mci == magic_colon); |
|
|
5007 |
|
|
5008 if (rhs.is_zero_by_zero ()) |
|
|
5009 { |
|
|
5010 delete_columns (rj); |
|
|
5011 } |
|
|
5012 else |
|
|
5013 { |
|
|
5014 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); |
|
|
5015 |
|
|
5016 int nr = rows (); |
|
|
5017 |
|
|
5018 double jb = rj.base (); |
|
|
5019 double jinc = rj.inc (); |
|
|
5020 |
|
|
5021 for (int j = 0; j < rj.nelem (); j++) |
|
|
5022 { |
|
|
5023 double jtmp = jb + j * jinc; |
|
|
5024 int col = tree_to_mat_idx (jtmp); |
|
|
5025 for (int i = 0; i < nr; i++) |
|
|
5026 { |
|
|
5027 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), |
|
|
5028 rhs_cm.elem (i, j), rhs.is_real_type ()); |
|
|
5029 } |
|
|
5030 } |
|
|
5031 } |
|
|
5032 } |
|
|
5033 |
|
|
5034 /* 16 */ |
|
|
5035 void |
|
631
|
5036 TC_REP::do_matrix_assignment (const tree_constant& rhs, |
|
|
5037 TC_REP::constant_type mci, |
|
|
5038 TC_REP::constant_type mcj) |
|
492
|
5039 { |
|
|
5040 assert (mci == magic_colon && mcj == magic_colon); |
|
|
5041 |
|
|
5042 switch (type_tag) |
|
|
5043 { |
|
|
5044 case scalar_constant: |
|
|
5045 break; |
|
631
|
5046 |
|
492
|
5047 case matrix_constant: |
|
|
5048 delete matrix; |
|
|
5049 break; |
|
631
|
5050 |
|
492
|
5051 case complex_scalar_constant: |
|
|
5052 delete complex_scalar; |
|
|
5053 break; |
|
631
|
5054 |
|
492
|
5055 case complex_matrix_constant: |
|
|
5056 delete complex_matrix; |
|
|
5057 break; |
|
631
|
5058 |
|
492
|
5059 case string_constant: |
|
|
5060 delete [] string; |
|
|
5061 break; |
|
631
|
5062 |
|
492
|
5063 case range_constant: |
|
|
5064 delete range; |
|
|
5065 break; |
|
631
|
5066 |
|
492
|
5067 case magic_colon: |
|
|
5068 default: |
|
|
5069 panic_impossible (); |
|
|
5070 break; |
|
|
5071 } |
|
|
5072 |
|
|
5073 type_tag = rhs.const_type (); |
|
|
5074 |
|
|
5075 switch (type_tag) |
|
|
5076 { |
|
|
5077 case scalar_constant: |
|
|
5078 scalar = rhs.double_value (); |
|
|
5079 break; |
|
631
|
5080 |
|
492
|
5081 case matrix_constant: |
|
|
5082 matrix = new Matrix (rhs.matrix_value ()); |
|
|
5083 break; |
|
631
|
5084 |
|
492
|
5085 case string_constant: |
|
|
5086 string = strsave (rhs.string_value ()); |
|
|
5087 break; |
|
631
|
5088 |
|
492
|
5089 case complex_matrix_constant: |
|
|
5090 complex_matrix = new ComplexMatrix (rhs.complex_matrix_value ()); |
|
|
5091 break; |
|
631
|
5092 |
|
492
|
5093 case complex_scalar_constant: |
|
|
5094 complex_scalar = new Complex (rhs.complex_value ()); |
|
|
5095 break; |
|
631
|
5096 |
|
492
|
5097 case range_constant: |
|
|
5098 range = new Range (rhs.range_value ()); |
|
|
5099 break; |
|
631
|
5100 |
|
492
|
5101 case magic_colon: |
|
|
5102 default: |
|
|
5103 panic_impossible (); |
|
|
5104 break; |
|
|
5105 } |
|
|
5106 } |
|
|
5107 |
|
581
|
5108 // Functions for deleting rows or columns of a matrix. These are used |
|
|
5109 // to handle statements like |
|
|
5110 // |
|
|
5111 // M (i, j) = [] |
|
|
5112 |
|
492
|
5113 void |
|
631
|
5114 TC_REP::delete_row (int idx) |
|
492
|
5115 { |
|
|
5116 if (type_tag == matrix_constant) |
|
|
5117 { |
|
|
5118 int nr = matrix->rows (); |
|
|
5119 int nc = matrix->columns (); |
|
|
5120 Matrix *new_matrix = new Matrix (nr-1, nc); |
|
|
5121 int ii = 0; |
|
|
5122 for (int i = 0; i < nr; i++) |
|
|
5123 { |
|
|
5124 if (i != idx) |
|
|
5125 { |
|
|
5126 for (int j = 0; j < nc; j++) |
|
|
5127 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
5128 ii++; |
|
|
5129 } |
|
|
5130 } |
|
|
5131 delete matrix; |
|
|
5132 matrix = new_matrix; |
|
|
5133 } |
|
|
5134 else if (type_tag == complex_matrix_constant) |
|
|
5135 { |
|
|
5136 int nr = complex_matrix->rows (); |
|
|
5137 int nc = complex_matrix->columns (); |
|
|
5138 ComplexMatrix *new_matrix = new ComplexMatrix (nr-1, nc); |
|
|
5139 int ii = 0; |
|
|
5140 for (int i = 0; i < nr; i++) |
|
|
5141 { |
|
|
5142 if (i != idx) |
|
|
5143 { |
|
|
5144 for (int j = 0; j < nc; j++) |
|
|
5145 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
5146 ii++; |
|
|
5147 } |
|
|
5148 } |
|
|
5149 delete complex_matrix; |
|
|
5150 complex_matrix = new_matrix; |
|
|
5151 } |
|
|
5152 else |
|
|
5153 panic_impossible (); |
|
|
5154 } |
|
|
5155 |
|
|
5156 void |
|
631
|
5157 TC_REP::delete_rows (idx_vector& iv) |
|
492
|
5158 { |
|
|
5159 iv.sort_uniq (); |
|
|
5160 int num_to_delete = iv.length (); |
|
|
5161 |
|
|
5162 int nr = rows (); |
|
|
5163 int nc = columns (); |
|
|
5164 |
|
|
5165 // If deleting all rows of a column vector, make result 0x0. |
|
|
5166 if (nc == 1 && num_to_delete == nr) |
|
|
5167 nc = 0; |
|
|
5168 |
|
|
5169 if (type_tag == matrix_constant) |
|
|
5170 { |
|
|
5171 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); |
|
|
5172 if (nr > num_to_delete) |
|
|
5173 { |
|
|
5174 int ii = 0; |
|
|
5175 int idx = 0; |
|
|
5176 for (int i = 0; i < nr; i++) |
|
|
5177 { |
|
|
5178 if (i == iv.elem (idx)) |
|
|
5179 idx++; |
|
|
5180 else |
|
|
5181 { |
|
|
5182 for (int j = 0; j < nc; j++) |
|
|
5183 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
5184 ii++; |
|
|
5185 } |
|
|
5186 } |
|
|
5187 } |
|
|
5188 delete matrix; |
|
|
5189 matrix = new_matrix; |
|
|
5190 } |
|
|
5191 else if (type_tag == complex_matrix_constant) |
|
|
5192 { |
|
|
5193 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); |
|
|
5194 if (nr > num_to_delete) |
|
|
5195 { |
|
|
5196 int ii = 0; |
|
|
5197 int idx = 0; |
|
|
5198 for (int i = 0; i < nr; i++) |
|
|
5199 { |
|
|
5200 if (i == iv.elem (idx)) |
|
|
5201 idx++; |
|
|
5202 else |
|
|
5203 { |
|
|
5204 for (int j = 0; j < nc; j++) |
|
|
5205 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
5206 ii++; |
|
|
5207 } |
|
|
5208 } |
|
|
5209 } |
|
|
5210 delete complex_matrix; |
|
|
5211 complex_matrix = new_matrix; |
|
|
5212 } |
|
|
5213 else |
|
|
5214 panic_impossible (); |
|
|
5215 } |
|
|
5216 |
|
|
5217 void |
|
631
|
5218 TC_REP::delete_rows (Range& ri) |
|
492
|
5219 { |
|
|
5220 ri.sort (); |
|
|
5221 int num_to_delete = ri.nelem (); |
|
|
5222 |
|
|
5223 int nr = rows (); |
|
|
5224 int nc = columns (); |
|
|
5225 |
|
|
5226 // If deleting all rows of a column vector, make result 0x0. |
|
|
5227 if (nc == 1 && num_to_delete == nr) |
|
|
5228 nc = 0; |
|
|
5229 |
|
|
5230 double ib = ri.base (); |
|
|
5231 double iinc = ri.inc (); |
|
|
5232 |
|
|
5233 int max_idx = tree_to_mat_idx (ri.max ()); |
|
|
5234 |
|
|
5235 if (type_tag == matrix_constant) |
|
|
5236 { |
|
|
5237 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); |
|
|
5238 if (nr > num_to_delete) |
|
|
5239 { |
|
|
5240 int ii = 0; |
|
|
5241 int idx = 0; |
|
|
5242 for (int i = 0; i < nr; i++) |
|
|
5243 { |
|
|
5244 double itmp = ib + idx * iinc; |
|
|
5245 int row = tree_to_mat_idx (itmp); |
|
|
5246 |
|
|
5247 if (i == row && row <= max_idx) |
|
|
5248 idx++; |
|
|
5249 else |
|
|
5250 { |
|
|
5251 for (int j = 0; j < nc; j++) |
|
|
5252 new_matrix->elem (ii, j) = matrix->elem (i, j); |
|
|
5253 ii++; |
|
|
5254 } |
|
|
5255 } |
|
|
5256 } |
|
|
5257 delete matrix; |
|
|
5258 matrix = new_matrix; |
|
|
5259 } |
|
|
5260 else if (type_tag == complex_matrix_constant) |
|
|
5261 { |
|
|
5262 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); |
|
|
5263 if (nr > num_to_delete) |
|
|
5264 { |
|
|
5265 int ii = 0; |
|
|
5266 int idx = 0; |
|
|
5267 for (int i = 0; i < nr; i++) |
|
|
5268 { |
|
|
5269 double itmp = ib + idx * iinc; |
|
|
5270 int row = tree_to_mat_idx (itmp); |
|
|
5271 |
|
|
5272 if (i == row && row <= max_idx) |
|
|
5273 idx++; |
|
|
5274 else |
|
|
5275 { |
|
|
5276 for (int j = 0; j < nc; j++) |
|
|
5277 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); |
|
|
5278 ii++; |
|
|
5279 } |
|
|
5280 } |
|
|
5281 } |
|
|
5282 delete complex_matrix; |
|
|
5283 complex_matrix = new_matrix; |
|
|
5284 } |
|
|
5285 else |
|
|
5286 panic_impossible (); |
|
|
5287 } |
|
|
5288 |
|
|
5289 void |
|
631
|
5290 TC_REP::delete_column (int idx) |
|
492
|
5291 { |
|
|
5292 if (type_tag == matrix_constant) |
|
|
5293 { |
|
|
5294 int nr = matrix->rows (); |
|
|
5295 int nc = matrix->columns (); |
|
|
5296 Matrix *new_matrix = new Matrix (nr, nc-1); |
|
|
5297 int jj = 0; |
|
|
5298 for (int j = 0; j < nc; j++) |
|
|
5299 { |
|
|
5300 if (j != idx) |
|
|
5301 { |
|
|
5302 for (int i = 0; i < nr; i++) |
|
|
5303 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
5304 jj++; |
|
|
5305 } |
|
|
5306 } |
|
|
5307 delete matrix; |
|
|
5308 matrix = new_matrix; |
|
|
5309 } |
|
|
5310 else if (type_tag == complex_matrix_constant) |
|
|
5311 { |
|
|
5312 int nr = complex_matrix->rows (); |
|
|
5313 int nc = complex_matrix->columns (); |
|
|
5314 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-1); |
|
|
5315 int jj = 0; |
|
|
5316 for (int j = 0; j < nc; j++) |
|
|
5317 { |
|
|
5318 if (j != idx) |
|
|
5319 { |
|
|
5320 for (int i = 0; i < nr; i++) |
|
|
5321 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
5322 jj++; |
|
|
5323 } |
|
|
5324 } |
|
|
5325 delete complex_matrix; |
|
|
5326 complex_matrix = new_matrix; |
|
|
5327 } |
|
|
5328 else |
|
|
5329 panic_impossible (); |
|
|
5330 } |
|
|
5331 |
|
|
5332 void |
|
631
|
5333 TC_REP::delete_columns (idx_vector& jv) |
|
492
|
5334 { |
|
|
5335 jv.sort_uniq (); |
|
|
5336 int num_to_delete = jv.length (); |
|
|
5337 |
|
|
5338 int nr = rows (); |
|
|
5339 int nc = columns (); |
|
|
5340 |
|
|
5341 // If deleting all columns of a row vector, make result 0x0. |
|
|
5342 if (nr == 1 && num_to_delete == nc) |
|
|
5343 nr = 0; |
|
|
5344 |
|
|
5345 if (type_tag == matrix_constant) |
|
|
5346 { |
|
|
5347 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); |
|
|
5348 if (nc > num_to_delete) |
|
|
5349 { |
|
|
5350 int jj = 0; |
|
|
5351 int idx = 0; |
|
|
5352 for (int j = 0; j < nc; j++) |
|
|
5353 { |
|
|
5354 if (j == jv.elem (idx)) |
|
|
5355 idx++; |
|
|
5356 else |
|
|
5357 { |
|
|
5358 for (int i = 0; i < nr; i++) |
|
|
5359 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
5360 jj++; |
|
|
5361 } |
|
|
5362 } |
|
|
5363 } |
|
|
5364 delete matrix; |
|
|
5365 matrix = new_matrix; |
|
|
5366 } |
|
|
5367 else if (type_tag == complex_matrix_constant) |
|
|
5368 { |
|
|
5369 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); |
|
|
5370 if (nc > num_to_delete) |
|
|
5371 { |
|
|
5372 int jj = 0; |
|
|
5373 int idx = 0; |
|
|
5374 for (int j = 0; j < nc; j++) |
|
|
5375 { |
|
|
5376 if (j == jv.elem (idx)) |
|
|
5377 idx++; |
|
|
5378 else |
|
|
5379 { |
|
|
5380 for (int i = 0; i < nr; i++) |
|
|
5381 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
5382 jj++; |
|
|
5383 } |
|
|
5384 } |
|
|
5385 } |
|
|
5386 delete complex_matrix; |
|
|
5387 complex_matrix = new_matrix; |
|
|
5388 } |
|
|
5389 else |
|
|
5390 panic_impossible (); |
|
|
5391 } |
|
|
5392 |
|
|
5393 void |
|
631
|
5394 TC_REP::delete_columns (Range& rj) |
|
492
|
5395 { |
|
|
5396 rj.sort (); |
|
|
5397 int num_to_delete = rj.nelem (); |
|
|
5398 |
|
|
5399 int nr = rows (); |
|
|
5400 int nc = columns (); |
|
|
5401 |
|
|
5402 // If deleting all columns of a row vector, make result 0x0. |
|
|
5403 if (nr == 1 && num_to_delete == nc) |
|
|
5404 nr = 0; |
|
|
5405 |
|
|
5406 double jb = rj.base (); |
|
|
5407 double jinc = rj.inc (); |
|
|
5408 |
|
|
5409 int max_idx = tree_to_mat_idx (rj.max ()); |
|
|
5410 |
|
|
5411 if (type_tag == matrix_constant) |
|
|
5412 { |
|
|
5413 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); |
|
|
5414 if (nc > num_to_delete) |
|
|
5415 { |
|
|
5416 int jj = 0; |
|
|
5417 int idx = 0; |
|
|
5418 for (int j = 0; j < nc; j++) |
|
|
5419 { |
|
|
5420 double jtmp = jb + idx * jinc; |
|
|
5421 int col = tree_to_mat_idx (jtmp); |
|
|
5422 |
|
|
5423 if (j == col && col <= max_idx) |
|
|
5424 idx++; |
|
|
5425 else |
|
|
5426 { |
|
|
5427 for (int i = 0; i < nr; i++) |
|
|
5428 new_matrix->elem (i, jj) = matrix->elem (i, j); |
|
|
5429 jj++; |
|
|
5430 } |
|
|
5431 } |
|
|
5432 } |
|
|
5433 delete matrix; |
|
|
5434 matrix = new_matrix; |
|
|
5435 } |
|
|
5436 else if (type_tag == complex_matrix_constant) |
|
|
5437 { |
|
|
5438 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); |
|
|
5439 if (nc > num_to_delete) |
|
|
5440 { |
|
|
5441 int jj = 0; |
|
|
5442 int idx = 0; |
|
|
5443 for (int j = 0; j < nc; j++) |
|
|
5444 { |
|
|
5445 double jtmp = jb + idx * jinc; |
|
|
5446 int col = tree_to_mat_idx (jtmp); |
|
|
5447 |
|
|
5448 if (j == col && col <= max_idx) |
|
|
5449 idx++; |
|
|
5450 else |
|
|
5451 { |
|
|
5452 for (int i = 0; i < nr; i++) |
|
|
5453 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); |
|
|
5454 jj++; |
|
|
5455 } |
|
|
5456 } |
|
|
5457 } |
|
|
5458 delete complex_matrix; |
|
|
5459 complex_matrix = new_matrix; |
|
|
5460 } |
|
|
5461 else |
|
|
5462 panic_impossible (); |
|
|
5463 } |
|
|
5464 |
|
631
|
5465 void |
|
|
5466 TC_REP::maybe_mutate (void) |
|
492
|
5467 { |
|
631
|
5468 if (error_state) |
|
|
5469 return; |
|
581
|
5470 |
|
|
5471 switch (type_tag) |
|
|
5472 { |
|
|
5473 case complex_scalar_constant: |
|
631
|
5474 if (::imag (*complex_scalar) == 0.0) |
|
|
5475 { |
|
|
5476 double d = ::real (*complex_scalar); |
|
|
5477 delete complex_scalar; |
|
|
5478 scalar = d; |
|
|
5479 type_tag = scalar_constant; |
|
|
5480 } |
|
|
5481 break; |
|
|
5482 |
|
|
5483 case complex_matrix_constant: |
|
|
5484 if (! any_element_is_complex (*complex_matrix)) |
|
|
5485 { |
|
|
5486 Matrix *m = new Matrix (::real (*complex_matrix)); |
|
|
5487 delete complex_matrix; |
|
|
5488 matrix = m; |
|
|
5489 type_tag = matrix_constant; |
|
|
5490 } |
|
|
5491 break; |
|
|
5492 |
|
581
|
5493 case scalar_constant: |
|
631
|
5494 case matrix_constant: |
|
|
5495 case string_constant: |
|
|
5496 case range_constant: |
|
|
5497 case magic_colon: |
|
|
5498 break; |
|
|
5499 |
|
|
5500 default: |
|
|
5501 panic_impossible (); |
|
|
5502 break; |
|
|
5503 } |
|
|
5504 |
|
|
5505 // Avoid calling rows() and columns() for things like magic_colon. |
|
|
5506 |
|
|
5507 int nr = 1; |
|
|
5508 int nc = 1; |
|
|
5509 if (type_tag == matrix_constant |
|
|
5510 || type_tag == complex_matrix_constant |
|
|
5511 || type_tag == range_constant) |
|
|
5512 { |
|
|
5513 nr = rows (); |
|
|
5514 nc = columns (); |
|
|
5515 } |
|
|
5516 |
|
|
5517 switch (type_tag) |
|
|
5518 { |
|
|
5519 case matrix_constant: |
|
|
5520 if (nr == 1 && nc == 1) |
|
|
5521 { |
|
|
5522 double d = matrix->elem (0, 0); |
|
|
5523 delete matrix; |
|
|
5524 scalar = d; |
|
|
5525 type_tag = scalar_constant; |
|
|
5526 } |
|
|
5527 break; |
|
|
5528 |
|
581
|
5529 case complex_matrix_constant: |
|
631
|
5530 if (nr == 1 && nc == 1) |
|
|
5531 { |
|
|
5532 Complex c = complex_matrix->elem (0, 0); |
|
|
5533 delete complex_matrix; |
|
|
5534 complex_scalar = new Complex (c); |
|
|
5535 type_tag = complex_scalar_constant; |
|
|
5536 } |
|
|
5537 break; |
|
|
5538 |
|
|
5539 case range_constant: |
|
|
5540 if (nr == 1 && nc == 1) |
|
|
5541 { |
|
|
5542 double d = range->base (); |
|
|
5543 delete range; |
|
|
5544 scalar = d; |
|
|
5545 type_tag = scalar_constant; |
|
|
5546 } |
|
|
5547 break; |
|
|
5548 |
|
|
5549 default: |
|
|
5550 break; |
|
|
5551 } |
|
|
5552 } |
|
|
5553 |
|
|
5554 void |
|
|
5555 TC_REP::print (void) |
|
|
5556 { |
|
|
5557 if (error_state) |
|
|
5558 return; |
|
|
5559 |
|
|
5560 if (print) |
|
|
5561 { |
|
|
5562 ostrstream output_buf; |
|
|
5563 |
|
|
5564 switch (type_tag) |
|
|
5565 { |
|
|
5566 case scalar_constant: |
|
|
5567 octave_print_internal (output_buf, scalar); |
|
|
5568 break; |
|
|
5569 |
|
|
5570 case matrix_constant: |
|
|
5571 octave_print_internal (output_buf, *matrix); |
|
|
5572 break; |
|
|
5573 |
|
|
5574 case complex_scalar_constant: |
|
|
5575 octave_print_internal (output_buf, *complex_scalar); |
|
|
5576 break; |
|
|
5577 |
|
|
5578 case complex_matrix_constant: |
|
|
5579 octave_print_internal (output_buf, *complex_matrix); |
|
|
5580 break; |
|
|
5581 |
|
|
5582 case string_constant: |
|
|
5583 output_buf << string << "\n"; |
|
|
5584 break; |
|
|
5585 |
|
|
5586 case range_constant: |
|
|
5587 octave_print_internal (output_buf, *range); |
|
|
5588 break; |
|
|
5589 |
|
|
5590 case magic_colon: |
|
|
5591 default: |
|
|
5592 panic_impossible (); |
|
|
5593 break; |
|
|
5594 } |
|
|
5595 |
|
|
5596 output_buf << ends; |
|
|
5597 maybe_page_output (output_buf); |
|
|
5598 } |
|
|
5599 } |
|
|
5600 |
|
|
5601 static char * |
|
|
5602 undo_string_escapes (char c) |
|
|
5603 { |
|
|
5604 static char retval[2]; |
|
|
5605 retval[1] = '\0'; |
|
|
5606 |
|
|
5607 if (! c) |
|
|
5608 return 0; |
|
|
5609 |
|
|
5610 switch (c) |
|
|
5611 { |
|
|
5612 case '\a': |
|
|
5613 return "\\a"; |
|
|
5614 |
|
|
5615 case '\b': // backspace |
|
|
5616 return "\\b"; |
|
|
5617 |
|
|
5618 case '\f': // formfeed |
|
|
5619 return "\\f"; |
|
|
5620 |
|
|
5621 case '\n': // newline |
|
|
5622 return "\\n"; |
|
|
5623 |
|
|
5624 case '\r': // carriage return |
|
|
5625 return "\\r"; |
|
|
5626 |
|
|
5627 case '\t': // horizontal tab |
|
|
5628 return "\\t"; |
|
|
5629 |
|
|
5630 case '\v': // vertical tab |
|
|
5631 return "\\v"; |
|
|
5632 |
|
|
5633 case '\\': // backslash |
|
|
5634 return "\\\\"; |
|
|
5635 |
|
|
5636 case '"': // double quote |
|
|
5637 return "\\\""; |
|
|
5638 |
|
|
5639 default: |
|
|
5640 retval[0] = c; |
|
|
5641 return retval; |
|
|
5642 } |
|
|
5643 } |
|
|
5644 |
|
|
5645 void |
|
|
5646 TC_REP::print_code (ostream& os) |
|
|
5647 { |
|
|
5648 switch (type_tag) |
|
|
5649 { |
|
|
5650 case scalar_constant: |
|
|
5651 if (orig_text) |
|
|
5652 os << orig_text; |
|
|
5653 else |
|
|
5654 octave_print_internal (os, scalar, 1); |
|
|
5655 break; |
|
|
5656 |
|
|
5657 case matrix_constant: |
|
|
5658 octave_print_internal (os, *matrix, 1); |
|
|
5659 break; |
|
|
5660 |
|
|
5661 case complex_scalar_constant: |
|
|
5662 { |
|
|
5663 double re = complex_scalar->real (); |
|
|
5664 double im = complex_scalar->imag (); |
|
|
5665 |
|
|
5666 // If we have the original text and a pure imaginary, just print the |
|
|
5667 // original text, because this must be a constant that was parsed as |
|
|
5668 // part of a function. |
|
|
5669 |
|
|
5670 if (orig_text && re == 0.0 && im > 0.0) |
|
|
5671 os << orig_text; |
|
|
5672 else |
|
|
5673 octave_print_internal (os, *complex_scalar, 1); |
|
|
5674 } |
|
|
5675 break; |
|
|
5676 |
|
|
5677 case complex_matrix_constant: |
|
|
5678 octave_print_internal (os, *complex_matrix, 1); |
|
|
5679 break; |
|
|
5680 |
|
|
5681 case string_constant: |
|
|
5682 { |
|
|
5683 os << "\""; |
|
|
5684 char *s, *t = string; |
|
|
5685 while (s = undo_string_escapes (*t++)) |
|
|
5686 os << s; |
|
|
5687 os << "\""; |
|
|
5688 } |
|
|
5689 break; |
|
|
5690 |
|
|
5691 case range_constant: |
|
|
5692 octave_print_internal (os, *range, 1); |
|
|
5693 break; |
|
|
5694 |
|
|
5695 case magic_colon: |
|
|
5696 os << ":"; |
|
|
5697 break; |
|
|
5698 |
|
|
5699 default: |
|
|
5700 panic_impossible (); |
|
|
5701 break; |
|
|
5702 } |
|
|
5703 } |
|
|
5704 |
|
|
5705 char * |
|
|
5706 TC_REP::type_as_string (void) const |
|
|
5707 { |
|
|
5708 switch (type_tag) |
|
|
5709 { |
|
|
5710 case scalar_constant: |
|
|
5711 return "real scalar"; |
|
|
5712 |
|
581
|
5713 case matrix_constant: |
|
631
|
5714 return "real matrix"; |
|
|
5715 |
|
|
5716 case complex_scalar_constant: |
|
|
5717 return "complex scalar"; |
|
|
5718 |
|
|
5719 case complex_matrix_constant: |
|
|
5720 return "complex matrix"; |
|
|
5721 |
|
|
5722 case string_constant: |
|
|
5723 return "string"; |
|
|
5724 |
|
581
|
5725 case range_constant: |
|
631
|
5726 return "range"; |
|
|
5727 |
|
|
5728 default: |
|
|
5729 return "<unknown type>"; |
|
|
5730 } |
|
|
5731 } |
|
|
5732 |
|
|
5733 tree_constant |
|
|
5734 do_binary_op (tree_constant& a, tree_constant& b, tree_expression::type t) |
|
|
5735 { |
|
|
5736 tree_constant ans; |
|
|
5737 |
|
|
5738 int first_empty = (a.rows () == 0 || a.columns () == 0); |
|
|
5739 int second_empty = (b.rows () == 0 || b.columns () == 0); |
|
|
5740 |
|
|
5741 if (first_empty || second_empty) |
|
|
5742 { |
|
|
5743 int flag = user_pref.propagate_empty_matrices; |
|
|
5744 if (flag < 0) |
|
|
5745 warning ("binary operation on empty matrix"); |
|
|
5746 else if (flag == 0) |
|
|
5747 { |
|
|
5748 ::error ("invalid binary operation on empty matrix"); |
|
|
5749 return ans; |
|
|
5750 } |
|
|
5751 } |
|
|
5752 |
|
|
5753 tree_constant tmp_a = a.make_numeric (); |
|
|
5754 tree_constant tmp_b = b.make_numeric (); |
|
|
5755 |
|
|
5756 TC_REP::constant_type a_type = tmp_a.const_type (); |
|
|
5757 TC_REP::constant_type b_type = tmp_b.const_type (); |
|
|
5758 |
|
|
5759 double d1, d2; |
|
|
5760 Matrix m1, m2; |
|
|
5761 Complex c1, c2; |
|
|
5762 ComplexMatrix cm1, cm2; |
|
|
5763 |
|
|
5764 switch (a_type) |
|
|
5765 { |
|
|
5766 case TC_REP::scalar_constant: |
|
|
5767 |
|
|
5768 d1 = tmp_a.double_value (); |
|
|
5769 |
|
|
5770 switch (b_type) |
|
|
5771 { |
|
|
5772 case TC_REP::scalar_constant: |
|
|
5773 d2 = tmp_b.double_value (); |
|
|
5774 ans = do_binary_op (d1, d2, t); |
|
|
5775 break; |
|
|
5776 |
|
|
5777 case TC_REP::matrix_constant: |
|
|
5778 m2 = tmp_b.matrix_value (); |
|
|
5779 ans = do_binary_op (d1, m2, t); |
|
|
5780 break; |
|
|
5781 |
|
|
5782 case TC_REP::complex_scalar_constant: |
|
|
5783 c2 = tmp_b.complex_value (); |
|
|
5784 ans = do_binary_op (d1, c2, t); |
|
|
5785 break; |
|
|
5786 |
|
|
5787 case TC_REP::complex_matrix_constant: |
|
|
5788 cm2 = tmp_b.complex_matrix_value (); |
|
|
5789 ans = do_binary_op (d1, cm2, t); |
|
|
5790 break; |
|
|
5791 |
|
|
5792 case TC_REP::magic_colon: |
|
|
5793 default: |
|
|
5794 panic_impossible (); |
|
|
5795 break; |
|
|
5796 } |
|
|
5797 break; |
|
|
5798 |
|
|
5799 case TC_REP::matrix_constant: |
|
|
5800 |
|
|
5801 m1 = tmp_a.matrix_value (); |
|
|
5802 |
|
|
5803 switch (b_type) |
|
|
5804 { |
|
|
5805 case TC_REP::scalar_constant: |
|
|
5806 d2 = tmp_b.double_value (); |
|
|
5807 ans = do_binary_op (m1, d2, t); |
|
|
5808 break; |
|
|
5809 |
|
|
5810 case TC_REP::matrix_constant: |
|
|
5811 m2 = tmp_b.matrix_value (); |
|
|
5812 ans = do_binary_op (m1, m2, t); |
|
|
5813 break; |
|
|
5814 |
|
|
5815 case TC_REP::complex_scalar_constant: |
|
|
5816 c2 = tmp_b.complex_value (); |
|
|
5817 ans = do_binary_op (m1, c2, t); |
|
|
5818 break; |
|
|
5819 |
|
|
5820 case TC_REP::complex_matrix_constant: |
|
|
5821 cm2 = tmp_b.complex_matrix_value (); |
|
|
5822 ans = do_binary_op (m1, cm2, t); |
|
|
5823 break; |
|
|
5824 |
|
|
5825 case TC_REP::magic_colon: |
|
|
5826 default: |
|
|
5827 panic_impossible (); |
|
|
5828 break; |
|
|
5829 } |
|
|
5830 break; |
|
|
5831 |
|
|
5832 case TC_REP::complex_scalar_constant: |
|
|
5833 |
|
|
5834 c1 = tmp_a.complex_value (); |
|
|
5835 |
|
|
5836 switch (b_type) |
|
|
5837 { |
|
|
5838 case TC_REP::scalar_constant: |
|
|
5839 d2 = tmp_b.double_value (); |
|
|
5840 ans = do_binary_op (c1, d2, t); |
|
|
5841 break; |
|
|
5842 |
|
|
5843 case TC_REP::matrix_constant: |
|
|
5844 m2 = tmp_b.matrix_value (); |
|
|
5845 ans = do_binary_op (c1, m2, t); |
|
|
5846 break; |
|
|
5847 |
|
|
5848 case TC_REP::complex_scalar_constant: |
|
|
5849 c2 = tmp_b.complex_value (); |
|
|
5850 ans = do_binary_op (c1, c2, t); |
|
|
5851 break; |
|
|
5852 |
|
|
5853 case TC_REP::complex_matrix_constant: |
|
|
5854 cm2 = tmp_b.complex_matrix_value (); |
|
|
5855 ans = do_binary_op (c1, cm2, t); |
|
|
5856 break; |
|
|
5857 |
|
|
5858 case TC_REP::magic_colon: |
|
|
5859 default: |
|
|
5860 panic_impossible (); |
|
|
5861 break; |
|
|
5862 } |
|
|
5863 break; |
|
|
5864 |
|
|
5865 case TC_REP::complex_matrix_constant: |
|
|
5866 |
|
|
5867 cm1 = tmp_a.complex_matrix_value (); |
|
|
5868 |
|
|
5869 switch (b_type) |
|
|
5870 { |
|
|
5871 case TC_REP::scalar_constant: |
|
|
5872 d2 = tmp_b.double_value (); |
|
|
5873 ans = do_binary_op (cm1, d2, t); |
|
|
5874 break; |
|
|
5875 |
|
|
5876 case TC_REP::matrix_constant: |
|
|
5877 m2 = tmp_b.matrix_value (); |
|
|
5878 ans = do_binary_op (cm1, m2, t); |
|
|
5879 break; |
|
|
5880 |
|
|
5881 case TC_REP::complex_scalar_constant: |
|
|
5882 c2 = tmp_b.complex_value (); |
|
|
5883 ans = do_binary_op (cm1, c2, t); |
|
|
5884 break; |
|
|
5885 |
|
|
5886 case TC_REP::complex_matrix_constant: |
|
|
5887 cm2 = tmp_b.complex_matrix_value (); |
|
|
5888 ans = do_binary_op (cm1, cm2, t); |
|
|
5889 break; |
|
|
5890 |
|
|
5891 case TC_REP::magic_colon: |
|
|
5892 default: |
|
|
5893 panic_impossible (); |
|
|
5894 break; |
|
|
5895 } |
|
|
5896 break; |
|
|
5897 |
|
|
5898 case TC_REP::magic_colon: |
|
|
5899 default: |
|
|
5900 panic_impossible (); |
|
|
5901 break; |
|
|
5902 } |
|
|
5903 |
|
|
5904 return ans; |
|
|
5905 } |
|
|
5906 |
|
|
5907 tree_constant |
|
|
5908 do_unary_op (tree_constant& a, tree_expression::type t) |
|
|
5909 { |
|
|
5910 tree_constant ans; |
|
|
5911 |
|
|
5912 if (a.rows () == 0 || a.columns () == 0) |
|
|
5913 { |
|
|
5914 int flag = user_pref.propagate_empty_matrices; |
|
|
5915 if (flag < 0) |
|
|
5916 warning ("unary operation on empty matrix"); |
|
|
5917 else if (flag == 0) |
|
|
5918 { |
|
|
5919 ::error ("invalid unary operation on empty matrix"); |
|
|
5920 return ans; |
|
|
5921 } |
|
|
5922 } |
|
|
5923 |
|
|
5924 tree_constant tmp_a = a.make_numeric (); |
|
|
5925 |
|
|
5926 switch (tmp_a.const_type ()) |
|
|
5927 { |
|
|
5928 case TC_REP::scalar_constant: |
|
|
5929 ans = do_unary_op (tmp_a.double_value (), t); |
|
|
5930 break; |
|
|
5931 |
|
|
5932 case TC_REP::matrix_constant: |
|
|
5933 { |
|
|
5934 Matrix m = tmp_a.matrix_value (); |
|
|
5935 ans = do_unary_op (m, t); |
|
|
5936 } |
|
|
5937 break; |
|
|
5938 |
|
|
5939 case TC_REP::complex_scalar_constant: |
|
|
5940 ans = do_unary_op (tmp_a.complex_value (), t); |
|
|
5941 break; |
|
|
5942 |
|
|
5943 case TC_REP::complex_matrix_constant: |
|
|
5944 { |
|
|
5945 ComplexMatrix m = tmp_a.complex_matrix_value (); |
|
|
5946 ans = do_unary_op (m, t); |
|
|
5947 } |
|
|
5948 break; |
|
|
5949 |
|
|
5950 case TC_REP::magic_colon: |
|
|
5951 default: |
|
|
5952 panic_impossible (); |
|
|
5953 break; |
|
|
5954 } |
|
|
5955 |
|
|
5956 return ans; |
|
|
5957 } |
|
|
5958 |
|
|
5959 tree_constant |
|
|
5960 TC_REP::cumprod (void) const |
|
|
5961 { |
|
|
5962 if (type_tag == string_constant || type_tag == range_constant) |
|
|
5963 { |
|
|
5964 tree_constant tmp = make_numeric (); |
|
|
5965 return tmp.cumprod (); |
|
|
5966 } |
|
|
5967 |
|
|
5968 tree_constant retval; |
|
|
5969 |
|
|
5970 switch (type_tag) |
|
|
5971 { |
|
|
5972 case scalar_constant: |
|
|
5973 retval = tree_constant (scalar); |
|
|
5974 break; |
|
|
5975 |
|
|
5976 case matrix_constant: |
|
|
5977 { |
|
|
5978 Matrix m = matrix->cumprod (); |
|
|
5979 retval = tree_constant (m); |
|
|
5980 } |
|
|
5981 break; |
|
|
5982 |
|
|
5983 case complex_scalar_constant: |
|
|
5984 retval = tree_constant (*complex_scalar); |
|
|
5985 break; |
|
|
5986 |
|
|
5987 case complex_matrix_constant: |
|
|
5988 { |
|
|
5989 ComplexMatrix m = complex_matrix->cumprod (); |
|
|
5990 retval = tree_constant (m); |
|
|
5991 } |
|
|
5992 break; |
|
|
5993 |
|
581
|
5994 case string_constant: |
|
631
|
5995 case range_constant: |
|
581
|
5996 case magic_colon: |
|
|
5997 default: |
|
|
5998 panic_impossible (); |
|
|
5999 break; |
|
|
6000 } |
|
|
6001 |
|
529
|
6002 return retval; |
|
492
|
6003 } |
|
|
6004 |
|
|
6005 tree_constant |
|
631
|
6006 TC_REP::cumsum (void) const |
|
|
6007 { |
|
|
6008 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6009 { |
|
|
6010 tree_constant tmp = make_numeric (); |
|
|
6011 return tmp.cumsum (); |
|
|
6012 } |
|
|
6013 |
|
|
6014 tree_constant retval; |
|
|
6015 |
|
|
6016 switch (type_tag) |
|
|
6017 { |
|
|
6018 case scalar_constant: |
|
|
6019 retval = tree_constant (scalar); |
|
|
6020 break; |
|
|
6021 |
|
|
6022 case matrix_constant: |
|
|
6023 { |
|
|
6024 Matrix m = matrix->cumsum (); |
|
|
6025 retval = tree_constant (m); |
|
|
6026 } |
|
|
6027 break; |
|
|
6028 |
|
|
6029 case complex_scalar_constant: |
|
|
6030 retval = tree_constant (*complex_scalar); |
|
|
6031 break; |
|
|
6032 |
|
|
6033 case complex_matrix_constant: |
|
|
6034 { |
|
|
6035 ComplexMatrix m = complex_matrix->cumsum (); |
|
|
6036 retval = tree_constant (m); |
|
|
6037 } |
|
|
6038 break; |
|
|
6039 |
|
|
6040 case string_constant: |
|
|
6041 case range_constant: |
|
|
6042 case magic_colon: |
|
|
6043 default: |
|
|
6044 panic_impossible (); |
|
|
6045 break; |
|
|
6046 } |
|
|
6047 |
|
|
6048 return retval; |
|
|
6049 } |
|
|
6050 |
|
|
6051 tree_constant |
|
|
6052 TC_REP::prod (void) const |
|
|
6053 { |
|
|
6054 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6055 { |
|
|
6056 tree_constant tmp = make_numeric (); |
|
|
6057 return tmp.prod (); |
|
|
6058 } |
|
|
6059 |
|
|
6060 tree_constant retval; |
|
|
6061 |
|
|
6062 switch (type_tag) |
|
|
6063 { |
|
|
6064 case scalar_constant: |
|
|
6065 retval = tree_constant (scalar); |
|
|
6066 break; |
|
|
6067 |
|
|
6068 case matrix_constant: |
|
|
6069 { |
|
|
6070 Matrix m = matrix->prod (); |
|
|
6071 retval = tree_constant (m); |
|
|
6072 } |
|
|
6073 break; |
|
|
6074 |
|
|
6075 case complex_scalar_constant: |
|
|
6076 retval = tree_constant (*complex_scalar); |
|
|
6077 break; |
|
|
6078 |
|
|
6079 case complex_matrix_constant: |
|
|
6080 { |
|
|
6081 ComplexMatrix m = complex_matrix->prod (); |
|
|
6082 retval = tree_constant (m); |
|
|
6083 } |
|
|
6084 break; |
|
|
6085 |
|
|
6086 case string_constant: |
|
|
6087 case range_constant: |
|
|
6088 case magic_colon: |
|
|
6089 default: |
|
|
6090 panic_impossible (); |
|
|
6091 break; |
|
|
6092 } |
|
|
6093 |
|
|
6094 return retval; |
|
|
6095 } |
|
|
6096 |
|
|
6097 tree_constant |
|
|
6098 TC_REP::sum (void) const |
|
492
|
6099 { |
|
631
|
6100 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6101 { |
|
|
6102 tree_constant tmp = make_numeric (); |
|
|
6103 return tmp.sum (); |
|
|
6104 } |
|
|
6105 |
|
|
6106 tree_constant retval; |
|
|
6107 |
|
|
6108 switch (type_tag) |
|
|
6109 { |
|
|
6110 case scalar_constant: |
|
|
6111 retval = tree_constant (scalar); |
|
|
6112 break; |
|
|
6113 |
|
|
6114 case matrix_constant: |
|
|
6115 { |
|
|
6116 Matrix m = matrix->sum (); |
|
|
6117 retval = tree_constant (m); |
|
|
6118 } |
|
|
6119 break; |
|
|
6120 |
|
|
6121 case complex_scalar_constant: |
|
|
6122 retval = tree_constant (*complex_scalar); |
|
|
6123 break; |
|
|
6124 |
|
|
6125 case complex_matrix_constant: |
|
|
6126 { |
|
|
6127 ComplexMatrix m = complex_matrix->sum (); |
|
|
6128 retval = tree_constant (m); |
|
|
6129 } |
|
|
6130 break; |
|
|
6131 |
|
|
6132 case string_constant: |
|
|
6133 case range_constant: |
|
|
6134 case magic_colon: |
|
|
6135 default: |
|
|
6136 panic_impossible (); |
|
|
6137 break; |
|
|
6138 } |
|
|
6139 |
|
|
6140 return retval; |
|
|
6141 } |
|
|
6142 |
|
|
6143 tree_constant |
|
|
6144 TC_REP::sumsq (void) const |
|
|
6145 { |
|
|
6146 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6147 { |
|
|
6148 tree_constant tmp = make_numeric (); |
|
|
6149 return tmp.sumsq (); |
|
|
6150 } |
|
|
6151 |
|
|
6152 tree_constant retval; |
|
|
6153 |
|
|
6154 switch (type_tag) |
|
|
6155 { |
|
|
6156 case scalar_constant: |
|
|
6157 retval = tree_constant (scalar * scalar); |
|
|
6158 break; |
|
|
6159 |
|
|
6160 case matrix_constant: |
|
|
6161 { |
|
|
6162 Matrix m = matrix->sumsq (); |
|
|
6163 retval = tree_constant (m); |
|
|
6164 } |
|
|
6165 break; |
|
|
6166 |
|
|
6167 case complex_scalar_constant: |
|
|
6168 { |
|
|
6169 Complex c (*complex_scalar); |
|
|
6170 retval = tree_constant (c * c); |
|
|
6171 } |
|
|
6172 break; |
|
|
6173 |
|
|
6174 case complex_matrix_constant: |
|
|
6175 { |
|
|
6176 ComplexMatrix m = complex_matrix->sumsq (); |
|
|
6177 retval = tree_constant (m); |
|
|
6178 } |
|
|
6179 break; |
|
|
6180 |
|
|
6181 case string_constant: |
|
|
6182 case range_constant: |
|
|
6183 case magic_colon: |
|
|
6184 default: |
|
|
6185 panic_impossible (); |
|
|
6186 break; |
|
|
6187 } |
|
|
6188 |
|
|
6189 return retval; |
|
|
6190 } |
|
|
6191 |
|
|
6192 static tree_constant |
|
|
6193 make_diag (const Matrix& v, int k) |
|
|
6194 { |
|
|
6195 int nr = v.rows (); |
|
|
6196 int nc = v.columns (); |
|
|
6197 assert (nc == 1 || nr == 1); |
|
|
6198 |
|
|
6199 tree_constant retval; |
|
|
6200 |
|
|
6201 int roff = 0; |
|
|
6202 int coff = 0; |
|
|
6203 if (k > 0) |
|
|
6204 { |
|
|
6205 roff = 0; |
|
|
6206 coff = k; |
|
|
6207 } |
|
|
6208 else if (k < 0) |
|
|
6209 { |
|
|
6210 roff = -k; |
|
|
6211 coff = 0; |
|
|
6212 } |
|
|
6213 |
|
|
6214 if (nr == 1) |
|
|
6215 { |
|
|
6216 int n = nc + ABS (k); |
|
|
6217 Matrix m (n, n, 0.0); |
|
|
6218 for (int i = 0; i < nc; i++) |
|
|
6219 m.elem (i+roff, i+coff) = v.elem (0, i); |
|
|
6220 retval = tree_constant (m); |
|
|
6221 } |
|
|
6222 else |
|
|
6223 { |
|
|
6224 int n = nr + ABS (k); |
|
|
6225 Matrix m (n, n, 0.0); |
|
|
6226 for (int i = 0; i < nr; i++) |
|
|
6227 m.elem (i+roff, i+coff) = v.elem (i, 0); |
|
|
6228 retval = tree_constant (m); |
|
|
6229 } |
|
|
6230 |
|
|
6231 return retval; |
|
|
6232 } |
|
|
6233 |
|
|
6234 static tree_constant |
|
|
6235 make_diag (const ComplexMatrix& v, int k) |
|
|
6236 { |
|
|
6237 int nr = v.rows (); |
|
|
6238 int nc = v.columns (); |
|
|
6239 assert (nc == 1 || nr == 1); |
|
|
6240 |
|
|
6241 tree_constant retval; |
|
|
6242 |
|
|
6243 int roff = 0; |
|
|
6244 int coff = 0; |
|
|
6245 if (k > 0) |
|
|
6246 { |
|
|
6247 roff = 0; |
|
|
6248 coff = k; |
|
|
6249 } |
|
|
6250 else if (k < 0) |
|
|
6251 { |
|
|
6252 roff = -k; |
|
|
6253 coff = 0; |
|
|
6254 } |
|
|
6255 |
|
|
6256 if (nr == 1) |
|
|
6257 { |
|
|
6258 int n = nc + ABS (k); |
|
|
6259 ComplexMatrix m (n, n, 0.0); |
|
|
6260 for (int i = 0; i < nc; i++) |
|
|
6261 m.elem (i+roff, i+coff) = v.elem (0, i); |
|
|
6262 retval = tree_constant (m); |
|
|
6263 } |
|
|
6264 else |
|
|
6265 { |
|
|
6266 int n = nr + ABS (k); |
|
|
6267 ComplexMatrix m (n, n, 0.0); |
|
|
6268 for (int i = 0; i < nr; i++) |
|
|
6269 m.elem (i+roff, i+coff) = v.elem (i, 0); |
|
|
6270 retval = tree_constant (m); |
|
|
6271 } |
|
|
6272 |
|
|
6273 return retval; |
|
|
6274 } |
|
|
6275 |
|
|
6276 tree_constant |
|
|
6277 TC_REP::diag (void) const |
|
|
6278 { |
|
|
6279 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6280 { |
|
|
6281 tree_constant tmp = make_numeric (); |
|
|
6282 return tmp.diag (); |
|
|
6283 } |
|
492
|
6284 |
|
|
6285 tree_constant retval; |
|
631
|
6286 |
|
|
6287 switch (type_tag) |
|
|
6288 { |
|
|
6289 case scalar_constant: |
|
|
6290 retval = tree_constant (scalar); |
|
|
6291 break; |
|
|
6292 |
|
|
6293 case matrix_constant: |
|
|
6294 { |
|
|
6295 int nr = rows (); |
|
|
6296 int nc = columns (); |
|
|
6297 if (nr == 0 || nc == 0) |
|
|
6298 { |
|
|
6299 Matrix mtmp; |
|
|
6300 retval = tree_constant (mtmp); |
|
|
6301 } |
|
|
6302 else if (nr == 1 || nc == 1) |
|
|
6303 retval = make_diag (matrix_value (), 0); |
|
|
6304 else |
|
|
6305 { |
|
|
6306 ColumnVector v = matrix->diag (); |
|
|
6307 if (v.capacity () > 0) |
|
|
6308 retval = tree_constant (v); |
|
|
6309 } |
|
|
6310 } |
|
|
6311 break; |
|
|
6312 |
|
|
6313 case complex_scalar_constant: |
|
|
6314 retval = tree_constant (*complex_scalar); |
|
|
6315 break; |
|
|
6316 |
|
|
6317 case complex_matrix_constant: |
|
|
6318 { |
|
|
6319 int nr = rows (); |
|
|
6320 int nc = columns (); |
|
|
6321 if (nr == 0 || nc == 0) |
|
|
6322 { |
|
|
6323 Matrix mtmp; |
|
|
6324 retval = tree_constant (mtmp); |
|
|
6325 } |
|
|
6326 else if (nr == 1 || nc == 1) |
|
|
6327 retval = make_diag (complex_matrix_value (), 0); |
|
|
6328 else |
|
492
|
6329 { |
|
631
|
6330 ComplexColumnVector v = complex_matrix->diag (); |
|
|
6331 if (v.capacity () > 0) |
|
|
6332 retval = tree_constant (v); |
|
492
|
6333 } |
|
631
|
6334 } |
|
|
6335 break; |
|
|
6336 |
|
|
6337 case string_constant: |
|
|
6338 case range_constant: |
|
|
6339 case magic_colon: |
|
|
6340 default: |
|
|
6341 panic_impossible (); |
|
|
6342 break; |
|
|
6343 } |
|
|
6344 |
|
|
6345 return retval; |
|
|
6346 } |
|
|
6347 |
|
|
6348 tree_constant |
|
|
6349 TC_REP::diag (const tree_constant& a) const |
|
|
6350 { |
|
|
6351 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6352 { |
|
|
6353 tree_constant tmp = make_numeric (); |
|
|
6354 return tmp.diag (a); |
|
|
6355 } |
|
|
6356 |
|
|
6357 tree_constant tmp_a = a.make_numeric (); |
|
|
6358 |
|
|
6359 TC_REP::constant_type a_type = tmp_a.const_type (); |
|
|
6360 |
|
|
6361 tree_constant retval; |
|
|
6362 |
|
|
6363 switch (type_tag) |
|
|
6364 { |
|
|
6365 case scalar_constant: |
|
|
6366 if (a_type == scalar_constant) |
|
|
6367 { |
|
|
6368 int k = NINT (tmp_a.double_value ()); |
|
|
6369 int n = ABS (k) + 1; |
|
|
6370 if (k == 0) |
|
|
6371 retval = tree_constant (scalar); |
|
|
6372 else if (k > 0) |
|
|
6373 { |
|
|
6374 Matrix m (n, n, 0.0); |
|
|
6375 m.elem (0, k) = scalar; |
|
|
6376 retval = tree_constant (m); |
|
|
6377 } |
|
|
6378 else if (k < 0) |
|
|
6379 { |
|
|
6380 Matrix m (n, n, 0.0); |
|
|
6381 m.elem (-k, 0) = scalar; |
|
|
6382 retval = tree_constant (m); |
|
|
6383 } |
|
|
6384 } |
|
|
6385 break; |
|
|
6386 |
|
|
6387 case matrix_constant: |
|
|
6388 if (a_type == scalar_constant) |
|
|
6389 { |
|
|
6390 int k = NINT (tmp_a.double_value ()); |
|
|
6391 int nr = rows (); |
|
|
6392 int nc = columns (); |
|
|
6393 if (nr == 0 || nc == 0) |
|
|
6394 { |
|
|
6395 Matrix mtmp; |
|
|
6396 retval = tree_constant (mtmp); |
|
|
6397 } |
|
|
6398 else if (nr == 1 || nc == 1) |
|
|
6399 retval = make_diag (matrix_value (), k); |
|
|
6400 else |
|
|
6401 { |
|
|
6402 ColumnVector d = matrix->diag (k); |
|
|
6403 retval = tree_constant (d); |
|
|
6404 } |
|
|
6405 } |
|
|
6406 else |
|
|
6407 ::error ("diag: invalid second argument"); |
|
|
6408 |
|
|
6409 break; |
|
|
6410 |
|
|
6411 case complex_scalar_constant: |
|
|
6412 if (a_type == scalar_constant) |
|
|
6413 { |
|
|
6414 int k = NINT (tmp_a.double_value ()); |
|
|
6415 int n = ABS (k) + 1; |
|
|
6416 if (k == 0) |
|
|
6417 retval = tree_constant (*complex_scalar); |
|
|
6418 else if (k > 0) |
|
|
6419 { |
|
|
6420 ComplexMatrix m (n, n, 0.0); |
|
|
6421 m.elem (0, k) = *complex_scalar; |
|
|
6422 retval = tree_constant (m); |
|
|
6423 } |
|
|
6424 else if (k < 0) |
|
|
6425 { |
|
|
6426 ComplexMatrix m (n, n, 0.0); |
|
|
6427 m.elem (-k, 0) = *complex_scalar; |
|
|
6428 retval = tree_constant (m); |
|
|
6429 } |
|
|
6430 } |
|
|
6431 break; |
|
|
6432 |
|
|
6433 case complex_matrix_constant: |
|
|
6434 if (a_type == scalar_constant) |
|
|
6435 { |
|
|
6436 int k = NINT (tmp_a.double_value ()); |
|
|
6437 int nr = rows (); |
|
|
6438 int nc = columns (); |
|
|
6439 if (nr == 0 || nc == 0) |
|
|
6440 { |
|
|
6441 Matrix mtmp; |
|
|
6442 retval = tree_constant (mtmp); |
|
|
6443 } |
|
|
6444 else if (nr == 1 || nc == 1) |
|
|
6445 retval = make_diag (complex_matrix_value (), k); |
|
|
6446 else |
|
|
6447 { |
|
|
6448 ComplexColumnVector d = complex_matrix->diag (k); |
|
|
6449 retval = tree_constant (d); |
|
|
6450 } |
|
|
6451 } |
|
|
6452 else |
|
|
6453 ::error ("diag: invalid second argument"); |
|
|
6454 |
|
|
6455 break; |
|
|
6456 |
|
|
6457 case string_constant: |
|
|
6458 case range_constant: |
|
|
6459 case magic_colon: |
|
|
6460 default: |
|
|
6461 panic_impossible (); |
|
|
6462 break; |
|
|
6463 } |
|
|
6464 |
|
|
6465 return retval; |
|
|
6466 } |
|
|
6467 |
|
|
6468 // XXX FIXME XXX -- this can probably be rewritten efficiently as a |
|
|
6469 // nonmember function... |
|
|
6470 |
|
|
6471 tree_constant |
|
|
6472 TC_REP::mapper (Mapper_fcn& m_fcn, int print) const |
|
|
6473 { |
|
|
6474 tree_constant retval; |
|
|
6475 |
|
|
6476 if (type_tag == string_constant || type_tag == range_constant) |
|
|
6477 { |
|
|
6478 tree_constant tmp = make_numeric (); |
|
|
6479 return tmp.mapper (m_fcn, print); |
|
|
6480 } |
|
|
6481 |
|
|
6482 switch (type_tag) |
|
|
6483 { |
|
|
6484 case scalar_constant: |
|
|
6485 if (m_fcn.can_return_complex_for_real_arg |
|
|
6486 && (scalar < m_fcn.lower_limit |
|
|
6487 || scalar > m_fcn.upper_limit)) |
|
|
6488 { |
|
|
6489 if (m_fcn.c_c_mapper) |
|
|
6490 { |
|
|
6491 Complex c = m_fcn.c_c_mapper (Complex (scalar)); |
|
|
6492 retval = tree_constant (c); |
|
|
6493 } |
|
|
6494 else |
|
|
6495 ::error ("%s: unable to handle real arguments", m_fcn.name); |
|
|
6496 } |
|
|
6497 else |
|
|
6498 { |
|
|
6499 if (m_fcn.d_d_mapper) |
|
|
6500 { |
|
|
6501 double d = m_fcn.d_d_mapper (scalar); |
|
|
6502 retval = tree_constant (d); |
|
|
6503 } |
|
|
6504 else |
|
|
6505 ::error ("%s: unable to handle real arguments", m_fcn.name); |
|
|
6506 } |
|
|
6507 break; |
|
|
6508 |
|
|
6509 case matrix_constant: |
|
|
6510 if (m_fcn.can_return_complex_for_real_arg |
|
|
6511 && (any_element_less_than (*matrix, m_fcn.lower_limit) |
|
|
6512 || any_element_greater_than (*matrix, m_fcn.upper_limit))) |
|
|
6513 { |
|
|
6514 if (m_fcn.c_c_mapper) |
|
|
6515 { |
|
|
6516 ComplexMatrix cm = map (m_fcn.c_c_mapper, |
|
|
6517 ComplexMatrix (*matrix)); |
|
|
6518 retval = tree_constant (cm); |
|
|
6519 } |
|
|
6520 else |
|
|
6521 ::error ("%s: unable to handle real arguments", m_fcn.name); |
|
|
6522 } |
|
|
6523 else |
|
|
6524 { |
|
|
6525 if (m_fcn.d_d_mapper) |
|
|
6526 { |
|
|
6527 Matrix m = map (m_fcn.d_d_mapper, *matrix); |
|
|
6528 retval = tree_constant (m); |
|
|
6529 } |
|
|
6530 else |
|
|
6531 ::error ("%s: unable to handle real arguments", m_fcn.name); |
|
|
6532 } |
|
|
6533 break; |
|
|
6534 |
|
|
6535 case complex_scalar_constant: |
|
|
6536 if (m_fcn.d_c_mapper) |
|
|
6537 { |
|
|
6538 double d; |
|
|
6539 d = m_fcn.d_c_mapper (*complex_scalar); |
|
|
6540 retval = tree_constant (d); |
|
|
6541 } |
|
|
6542 else if (m_fcn.c_c_mapper) |
|
|
6543 { |
|
|
6544 Complex c; |
|
|
6545 c = m_fcn.c_c_mapper (*complex_scalar); |
|
|
6546 retval = tree_constant (c); |
|
|
6547 } |
|
|
6548 else |
|
|
6549 ::error ("%s: unable to handle complex arguments", m_fcn.name); |
|
|
6550 break; |
|
|
6551 |
|
|
6552 case complex_matrix_constant: |
|
|
6553 if (m_fcn.d_c_mapper) |
|
|
6554 { |
|
|
6555 Matrix m; |
|
|
6556 m = map (m_fcn.d_c_mapper, *complex_matrix); |
|
|
6557 retval = tree_constant (m); |
|
|
6558 } |
|
|
6559 else if (m_fcn.c_c_mapper) |
|
|
6560 { |
|
|
6561 ComplexMatrix cm; |
|
|
6562 cm = map (m_fcn.c_c_mapper, *complex_matrix); |
|
|
6563 retval = tree_constant (cm); |
|
|
6564 } |
|
|
6565 else |
|
|
6566 ::error ("%s: unable to handle complex arguments", m_fcn.name); |
|
|
6567 break; |
|
|
6568 |
|
|
6569 case string_constant: |
|
|
6570 case range_constant: |
|
|
6571 case magic_colon: |
|
|
6572 default: |
|
|
6573 panic_impossible (); |
|
|
6574 break; |
|
|
6575 } |
|
|
6576 |
|
492
|
6577 return retval; |
|
|
6578 } |
|
|
6579 |
|
|
6580 /* |
|
|
6581 ;;; Local Variables: *** |
|
|
6582 ;;; mode: C++ *** |
|
|
6583 ;;; page-delimiter: "^/\\*" *** |
|
|
6584 ;;; End: *** |
|
|
6585 */ |
