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