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