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