Mercurial > hg > octave-lyh
comparison src/pt-const.cc @ 455:8c6b86564cee
[project @ 1994-06-06 00:24:19 by jwe]
author | jwe |
---|---|
date | Mon, 06 Jun 1994 00:24:19 +0000 |
parents | 5e778965b6ea |
children | 794b6f480d72 |
comparison
equal
deleted
inserted
replaced
454:94cc7b5fc789 | 455:8c6b86564cee |
---|---|
23 | 23 |
24 #ifdef HAVE_CONFIG_H | 24 #ifdef HAVE_CONFIG_H |
25 #include "config.h" | 25 #include "config.h" |
26 #endif | 26 #endif |
27 | 27 |
28 #if defined (__GNUG__) | |
29 #pragma implementation | |
30 #endif | |
31 | |
28 #include <ctype.h> | 32 #include <ctype.h> |
29 #include <string.h> | 33 #include <string.h> |
34 #include <fstream.h> | |
30 #include <iostream.h> | 35 #include <iostream.h> |
31 #include <strstream.h> | 36 #include <strstream.h> |
32 #include <math.h> | 37 #include <math.h> |
38 | |
39 #include "mx-base.h" | |
40 #include "Range.h" | |
33 | 41 |
34 #include "variables.h" | 42 #include "variables.h" |
35 #include "error.h" | 43 #include "error.h" |
36 #include "gripes.h" | 44 #include "gripes.h" |
37 #include "user-prefs.h" | 45 #include "user-prefs.h" |
39 #include "pager.h" | 47 #include "pager.h" |
40 #include "mappers.h" | 48 #include "mappers.h" |
41 #include "pr-output.h" | 49 #include "pr-output.h" |
42 #include "tree-const.h" | 50 #include "tree-const.h" |
43 #include "arith-ops.h" | 51 #include "arith-ops.h" |
52 #include "idx-vector.h" | |
53 #include "unwind-prot.h" | |
54 #include "octave.h" | |
55 #include "input.h" | |
56 #include "octave-hist.h" | |
57 #include "parse.h" | |
58 #include "lex.h" | |
59 | |
60 #include "tc-inlines.cc" | |
44 | 61 |
45 // A couple of handy helper functions. | 62 // A couple of handy helper functions. |
46 | 63 |
47 static int | 64 static int |
48 any_element_less_than (const Matrix& a, double val) | 65 any_element_less_than (const Matrix& a, double val) |
122 matrix = new Matrix (d); | 139 matrix = new Matrix (d); |
123 type_tag = matrix_constant; | 140 type_tag = matrix_constant; |
124 } | 141 } |
125 } | 142 } |
126 | 143 |
127 tree_constant_rep::tree_constant_rep (const RowVector& v) | 144 tree_constant_rep::tree_constant_rep (const RowVector& v, int |
145 prefer_column_vector) | |
128 { | 146 { |
129 int len = v.capacity (); | 147 int len = v.capacity (); |
130 if (len == 1) | 148 if (len == 1) |
131 { | 149 { |
132 scalar = v.elem (0); | 150 scalar = v.elem (0); |
133 type_tag = scalar_constant; | 151 type_tag = scalar_constant; |
134 } | 152 } |
135 else | 153 else |
136 { | 154 { |
137 if (user_pref.prefer_column_vectors) | 155 int pcv = (prefer_column_vector < 0) |
156 ? user_pref.prefer_column_vectors | |
157 : prefer_column_vector; | |
158 | |
159 if (pcv) | |
138 { | 160 { |
139 Matrix m (len, 1); | 161 Matrix m (len, 1); |
140 for (int i = 0; i < len; i++) | 162 for (int i = 0; i < len; i++) |
141 m.elem (i, 0) = v.elem (i); | 163 m.elem (i, 0) = v.elem (i); |
142 matrix = new Matrix (m); | 164 matrix = new Matrix (m); |
151 type_tag = matrix_constant; | 173 type_tag = matrix_constant; |
152 } | 174 } |
153 } | 175 } |
154 } | 176 } |
155 | 177 |
156 tree_constant_rep::tree_constant_rep (const RowVector& v, int prefer_column_vector) | 178 tree_constant_rep::tree_constant_rep (const ColumnVector& v, |
179 int prefer_column_vector) | |
157 { | 180 { |
158 int len = v.capacity (); | 181 int len = v.capacity (); |
159 if (len == 1) | 182 if (len == 1) |
160 { | 183 { |
161 scalar = v.elem (0); | 184 scalar = v.elem (0); |
162 type_tag = scalar_constant; | 185 type_tag = scalar_constant; |
163 } | 186 } |
164 else | 187 else |
165 { | 188 { |
166 if (prefer_column_vector) | 189 int pcv = (prefer_column_vector < 0) |
190 ? user_pref.prefer_column_vectors | |
191 : prefer_column_vector; | |
192 | |
193 if (pcv) | |
167 { | 194 { |
168 Matrix m (len, 1); | 195 Matrix m (len, 1); |
169 for (int i = 0; i < len; i++) | 196 for (int i = 0; i < len; i++) |
170 m.elem (i, 0) = v.elem (i); | 197 m.elem (i, 0) = v.elem (i); |
171 matrix = new Matrix (m); | 198 matrix = new Matrix (m); |
180 type_tag = matrix_constant; | 207 type_tag = matrix_constant; |
181 } | 208 } |
182 } | 209 } |
183 } | 210 } |
184 | 211 |
185 tree_constant_rep::tree_constant_rep (const ColumnVector& v) | 212 tree_constant_rep::tree_constant_rep (const Complex& c) |
213 { | |
214 complex_scalar = new Complex (c); | |
215 type_tag = complex_scalar_constant; | |
216 } | |
217 | |
218 tree_constant_rep::tree_constant_rep (const ComplexMatrix& m) | |
219 { | |
220 if (m.rows () == 1 && m.columns () == 1) | |
221 { | |
222 complex_scalar = new Complex (m.elem (0, 0)); | |
223 type_tag = complex_scalar_constant; | |
224 } | |
225 else | |
226 { | |
227 complex_matrix = new ComplexMatrix (m); | |
228 type_tag = complex_matrix_constant; | |
229 } | |
230 } | |
231 | |
232 tree_constant_rep::tree_constant_rep (const ComplexDiagMatrix& d) | |
233 { | |
234 if (d.rows () == 1 && d.columns () == 1) | |
235 { | |
236 complex_scalar = new Complex (d.elem (0, 0)); | |
237 type_tag = complex_scalar_constant; | |
238 } | |
239 else | |
240 { | |
241 complex_matrix = new ComplexMatrix (d); | |
242 type_tag = complex_matrix_constant; | |
243 } | |
244 } | |
245 | |
246 tree_constant_rep::tree_constant_rep (const ComplexRowVector& v, | |
247 int prefer_column_vector) | |
186 { | 248 { |
187 int len = v.capacity (); | 249 int len = v.capacity (); |
188 if (len == 1) | 250 if (len == 1) |
189 { | 251 { |
190 scalar = v.elem (0); | |
191 type_tag = scalar_constant; | |
192 } | |
193 else | |
194 { | |
195 if (user_pref.prefer_column_vectors) | |
196 { | |
197 Matrix m (len, 1); | |
198 for (int i = 0; i < len; i++) | |
199 m.elem (i, 0) = v.elem (i); | |
200 matrix = new Matrix (m); | |
201 type_tag = matrix_constant; | |
202 } | |
203 else | |
204 { | |
205 Matrix m (1, len); | |
206 for (int i = 0; i < len; i++) | |
207 m.elem (0, i) = v.elem (i); | |
208 matrix = new Matrix (m); | |
209 type_tag = matrix_constant; | |
210 } | |
211 } | |
212 } | |
213 | |
214 tree_constant_rep::tree_constant_rep (const ColumnVector& v, | |
215 int prefer_column_vector) | |
216 { | |
217 int len = v.capacity (); | |
218 if (len == 1) | |
219 { | |
220 scalar = v.elem (0); | |
221 type_tag = scalar_constant; | |
222 } | |
223 else | |
224 { | |
225 if (prefer_column_vector) | |
226 { | |
227 Matrix m (len, 1); | |
228 for (int i = 0; i < len; i++) | |
229 m.elem (i, 0) = v.elem (i); | |
230 matrix = new Matrix (m); | |
231 type_tag = matrix_constant; | |
232 } | |
233 else | |
234 { | |
235 Matrix m (1, len); | |
236 for (int i = 0; i < len; i++) | |
237 m.elem (0, i) = v.elem (i); | |
238 matrix = new Matrix (m); | |
239 type_tag = matrix_constant; | |
240 } | |
241 } | |
242 } | |
243 | |
244 tree_constant_rep::tree_constant_rep (const Complex& c) | |
245 { | |
246 complex_scalar = new Complex (c); | |
247 type_tag = complex_scalar_constant; | |
248 } | |
249 | |
250 tree_constant_rep::tree_constant_rep (const ComplexRowVector& v) | |
251 { | |
252 int len = v.capacity (); | |
253 if (len == 1) | |
254 { | |
255 complex_scalar = new Complex (v.elem (0)); | 252 complex_scalar = new Complex (v.elem (0)); |
256 type_tag = complex_scalar_constant; | 253 type_tag = complex_scalar_constant; |
257 } | 254 } |
258 else | 255 else |
259 { | 256 { |
260 if (user_pref.prefer_column_vectors) | 257 int pcv = (prefer_column_vector < 0) |
258 ? user_pref.prefer_column_vectors | |
259 : prefer_column_vector; | |
260 | |
261 if (pcv) | |
261 { | 262 { |
262 ComplexMatrix m (len, 1); | 263 ComplexMatrix m (len, 1); |
263 for (int i = 0; i < len; i++) | 264 for (int i = 0; i < len; i++) |
264 m.elem (i, 0) = v.elem (i); | 265 m.elem (i, 0) = v.elem (i); |
265 complex_matrix = new ComplexMatrix (m); | 266 complex_matrix = new ComplexMatrix (m); |
274 type_tag = complex_matrix_constant; | 275 type_tag = complex_matrix_constant; |
275 } | 276 } |
276 } | 277 } |
277 } | 278 } |
278 | 279 |
279 tree_constant_rep::tree_constant_rep (const ComplexMatrix& m) | 280 tree_constant_rep::tree_constant_rep (const ComplexColumnVector& v, |
280 { | |
281 if (m.rows () == 1 && m.columns () == 1) | |
282 { | |
283 complex_scalar = new Complex (m.elem (0, 0)); | |
284 type_tag = complex_scalar_constant; | |
285 } | |
286 else | |
287 { | |
288 complex_matrix = new ComplexMatrix (m); | |
289 type_tag = complex_matrix_constant; | |
290 } | |
291 } | |
292 | |
293 tree_constant_rep::tree_constant_rep (const ComplexDiagMatrix& d) | |
294 { | |
295 if (d.rows () == 1 && d.columns () == 1) | |
296 { | |
297 complex_scalar = new Complex (d.elem (0, 0)); | |
298 type_tag = complex_scalar_constant; | |
299 } | |
300 else | |
301 { | |
302 complex_matrix = new ComplexMatrix (d); | |
303 type_tag = complex_matrix_constant; | |
304 } | |
305 } | |
306 | |
307 tree_constant_rep::tree_constant_rep (const ComplexRowVector& v, | |
308 int prefer_column_vector) | 281 int prefer_column_vector) |
309 { | 282 { |
310 int len = v.capacity (); | 283 int len = v.capacity (); |
311 if (len == 1) | 284 if (len == 1) |
312 { | 285 { |
313 complex_scalar = new Complex (v.elem (0)); | 286 complex_scalar = new Complex (v.elem (0)); |
314 type_tag = complex_scalar_constant; | 287 type_tag = complex_scalar_constant; |
315 } | 288 } |
316 else | 289 else |
317 { | 290 { |
318 if (prefer_column_vector) | 291 int pcv = (prefer_column_vector < 0) |
319 { | 292 ? user_pref.prefer_column_vectors |
320 ComplexMatrix m (len, 1); | 293 : prefer_column_vector; |
321 for (int i = 0; i < len; i++) | 294 |
322 m.elem (i, 0) = v.elem (i); | 295 if (pcv) |
323 complex_matrix = new ComplexMatrix (m); | |
324 type_tag = complex_matrix_constant; | |
325 } | |
326 else | |
327 { | |
328 ComplexMatrix m (1, len); | |
329 for (int i = 0; i < len; i++) | |
330 m.elem (0, i) = v.elem (i); | |
331 complex_matrix = new ComplexMatrix (m); | |
332 type_tag = complex_matrix_constant; | |
333 } | |
334 } | |
335 } | |
336 | |
337 tree_constant_rep::tree_constant_rep (const ComplexColumnVector& v) | |
338 { | |
339 int len = v.capacity (); | |
340 if (len == 1) | |
341 { | |
342 complex_scalar = new Complex (v.elem (0)); | |
343 type_tag = complex_scalar_constant; | |
344 } | |
345 else | |
346 { | |
347 if (user_pref.prefer_column_vectors) | |
348 { | |
349 ComplexMatrix m (len, 1); | |
350 for (int i = 0; i < len; i++) | |
351 m.elem (i, 0) = v.elem (i); | |
352 complex_matrix = new ComplexMatrix (m); | |
353 type_tag = complex_matrix_constant; | |
354 } | |
355 else | |
356 { | |
357 ComplexMatrix m (1, len); | |
358 for (int i = 0; i < len; i++) | |
359 m.elem (0, i) = v.elem (i); | |
360 complex_matrix = new ComplexMatrix (m); | |
361 type_tag = complex_matrix_constant; | |
362 } | |
363 } | |
364 } | |
365 | |
366 tree_constant_rep::tree_constant_rep (const ComplexColumnVector& v, | |
367 int prefer_column_vector) | |
368 { | |
369 int len = v.capacity (); | |
370 if (len == 1) | |
371 { | |
372 complex_scalar = new Complex (v.elem (0)); | |
373 type_tag = complex_scalar_constant; | |
374 } | |
375 else | |
376 { | |
377 if (prefer_column_vector) | |
378 { | 296 { |
379 ComplexMatrix m (len, 1); | 297 ComplexMatrix m (len, 1); |
380 for (int i = 0; i < len; i++) | 298 for (int i = 0; i < len; i++) |
381 m.elem (i, 0) = v.elem (i); | 299 m.elem (i, 0) = v.elem (i); |
382 complex_matrix = new ComplexMatrix (m); | 300 complex_matrix = new ComplexMatrix (m); |
1589 case complex_scalar_constant: | 1507 case complex_scalar_constant: |
1590 case complex_matrix_constant: | 1508 case complex_matrix_constant: |
1591 { | 1509 { |
1592 int flag = user_pref.ok_to_lose_imaginary_part; | 1510 int flag = user_pref.ok_to_lose_imaginary_part; |
1593 if (flag == -1) | 1511 if (flag == -1) |
1594 warning ("implicit conversion of complex matrix to real matrix"); | 1512 warning ("implicit conversion of complex matrix to real matrix"); |
1595 | 1513 |
1596 if (flag != 0) | 1514 if (flag != 0) |
1597 { | 1515 { |
1598 if (type_tag == complex_scalar_constant) | 1516 if (type_tag == complex_scalar_constant) |
1599 return Matrix (1, 1, ::real (*complex_scalar)); | 1517 return Matrix (1, 1, ::real (*complex_scalar)); |
2650 gripe_empty_arg (fcn_name, 1); | 2568 gripe_empty_arg (fcn_name, 1); |
2651 | 2569 |
2652 return retval; | 2570 return retval; |
2653 } | 2571 } |
2654 | 2572 |
2573 | |
2574 /* | |
2575 * Top-level tree-constant function that handles assignments. Only | |
2576 * decide if the left-hand side is currently a scalar or a matrix and | |
2577 * hand off to other functions to do the real work. | |
2578 */ | |
2579 void | |
2580 tree_constant_rep::assign (tree_constant& rhs, tree_constant *args, int nargs) | |
2581 { | |
2582 tree_constant rhs_tmp = rhs.make_numeric (); | |
2583 | |
2584 // This is easier than actually handling assignments to strings. | |
2585 // An assignment to a range will normally require a conversion to a | |
2586 // vector since it will normally destroy the equally-spaced property | |
2587 // of the range elements. | |
2588 | |
2589 if (type_tag == string_constant || type_tag == range_constant) | |
2590 force_numeric (); | |
2591 | |
2592 switch (type_tag) | |
2593 { | |
2594 case complex_scalar_constant: | |
2595 case scalar_constant: | |
2596 case unknown_constant: | |
2597 do_scalar_assignment (rhs_tmp, args, nargs); | |
2598 break; | |
2599 case complex_matrix_constant: | |
2600 case matrix_constant: | |
2601 do_matrix_assignment (rhs_tmp, args, nargs); | |
2602 break; | |
2603 case string_constant: | |
2604 ::error ("invalid assignment to string type"); | |
2605 break; | |
2606 case range_constant: | |
2607 case magic_colon: | |
2608 default: | |
2609 panic_impossible (); | |
2610 break; | |
2611 } | |
2612 } | |
2613 | |
2614 /* | |
2615 * Assignments to scalars. If resize_on_range_error is true, | |
2616 * this can convert the left-hand size to a matrix. | |
2617 */ | |
2618 void | |
2619 tree_constant_rep::do_scalar_assignment (tree_constant& rhs, | |
2620 tree_constant *args, int nargs) | |
2621 { | |
2622 assert (type_tag == unknown_constant | |
2623 || type_tag == scalar_constant | |
2624 || type_tag == complex_scalar_constant); | |
2625 | |
2626 if ((rhs.is_scalar_type () || rhs.is_zero_by_zero ()) | |
2627 && valid_scalar_indices (args, nargs)) | |
2628 { | |
2629 if (rhs.is_zero_by_zero ()) | |
2630 { | |
2631 if (type_tag == complex_scalar_constant) | |
2632 delete complex_scalar; | |
2633 | |
2634 matrix = new Matrix (0, 0); | |
2635 type_tag = matrix_constant; | |
2636 } | |
2637 else if (type_tag == unknown_constant || type_tag == scalar_constant) | |
2638 { | |
2639 if (rhs.const_type () == scalar_constant) | |
2640 { | |
2641 scalar = rhs.double_value (); | |
2642 type_tag = scalar_constant; | |
2643 } | |
2644 else if (rhs.const_type () == complex_scalar_constant) | |
2645 { | |
2646 complex_scalar = new Complex (rhs.complex_value ()); | |
2647 type_tag = complex_scalar_constant; | |
2648 } | |
2649 else | |
2650 { | |
2651 ::error ("invalid assignment to scalar"); | |
2652 return; | |
2653 } | |
2654 } | |
2655 else | |
2656 { | |
2657 if (rhs.const_type () == scalar_constant) | |
2658 { | |
2659 delete complex_scalar; | |
2660 scalar = rhs.double_value (); | |
2661 type_tag = scalar_constant; | |
2662 } | |
2663 else if (rhs.const_type () == complex_scalar_constant) | |
2664 { | |
2665 *complex_scalar = rhs.complex_value (); | |
2666 type_tag = complex_scalar_constant; | |
2667 } | |
2668 else | |
2669 { | |
2670 ::error ("invalid assignment to scalar"); | |
2671 return; | |
2672 } | |
2673 } | |
2674 } | |
2675 else if (user_pref.resize_on_range_error) | |
2676 { | |
2677 tree_constant_rep::constant_type old_type_tag = type_tag; | |
2678 | |
2679 if (type_tag == complex_scalar_constant) | |
2680 { | |
2681 Complex *old_complex = complex_scalar; | |
2682 complex_matrix = new ComplexMatrix (1, 1, *complex_scalar); | |
2683 type_tag = complex_matrix_constant; | |
2684 delete old_complex; | |
2685 } | |
2686 else if (type_tag == scalar_constant) | |
2687 { | |
2688 matrix = new Matrix (1, 1, scalar); | |
2689 type_tag = matrix_constant; | |
2690 } | |
2691 | |
2692 // If there is an error, the call to do_matrix_assignment should not | |
2693 // destroy the current value. tree_constant_rep::eval(int) will take | |
2694 // care of converting single element matrices back to scalars. | |
2695 | |
2696 do_matrix_assignment (rhs, args, nargs); | |
2697 | |
2698 // I don't think there's any other way to revert back to unknown | |
2699 // constant types, so here it is. | |
2700 | |
2701 if (old_type_tag == unknown_constant && error_state) | |
2702 { | |
2703 if (type_tag == matrix_constant) | |
2704 delete matrix; | |
2705 else if (type_tag == complex_matrix_constant) | |
2706 delete complex_matrix; | |
2707 | |
2708 type_tag = unknown_constant; | |
2709 } | |
2710 } | |
2711 else if (nargs > 3 || nargs < 2) | |
2712 ::error ("invalid index expression for scalar type"); | |
2713 else | |
2714 ::error ("index invalid or out of range for scalar type"); | |
2715 } | |
2716 | |
2717 /* | |
2718 * Assignments to matrices (and vectors). | |
2719 * | |
2720 * For compatibility with Matlab, we allow assignment of an empty | |
2721 * matrix to an expression with empty indices to do nothing. | |
2722 */ | |
2723 void | |
2724 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
2725 tree_constant *args, int nargs) | |
2726 { | |
2727 assert (type_tag == unknown_constant | |
2728 || type_tag == matrix_constant | |
2729 || type_tag == complex_matrix_constant); | |
2730 | |
2731 if (type_tag == matrix_constant && rhs.is_complex_type ()) | |
2732 { | |
2733 Matrix *old_matrix = matrix; | |
2734 complex_matrix = new ComplexMatrix (*matrix); | |
2735 type_tag = complex_matrix_constant; | |
2736 delete old_matrix; | |
2737 } | |
2738 else if (type_tag == unknown_constant) | |
2739 { | |
2740 if (rhs.is_complex_type ()) | |
2741 { | |
2742 complex_matrix = new ComplexMatrix (); | |
2743 type_tag = complex_matrix_constant; | |
2744 } | |
2745 else | |
2746 { | |
2747 matrix = new Matrix (); | |
2748 type_tag = matrix_constant; | |
2749 } | |
2750 } | |
2751 | |
2752 // The do_matrix_assignment functions can't handle empty matrices, so | |
2753 // don't let any pass through here. | |
2754 switch (nargs) | |
2755 { | |
2756 case 2: | |
2757 if (args == NULL_TREE_CONST) | |
2758 ::error ("matrix index is null"); | |
2759 else if (args[1].is_undefined ()) | |
2760 ::error ("matrix index is undefined"); | |
2761 else | |
2762 do_matrix_assignment (rhs, args[1]); | |
2763 break; | |
2764 case 3: | |
2765 if (args == NULL_TREE_CONST) | |
2766 ::error ("matrix indices are null"); | |
2767 else if (args[1].is_undefined ()) | |
2768 ::error ("first matrix index is undefined"); | |
2769 else if (args[2].is_undefined ()) | |
2770 ::error ("second matrix index is undefined"); | |
2771 else if (args[1].is_empty () || args[2].is_empty ()) | |
2772 { | |
2773 if (! rhs.is_empty ()) | |
2774 { | |
2775 ::error ("in assignment expression, a matrix index is empty"); | |
2776 ::error ("but hte right hand side is not an empty matrix"); | |
2777 } | |
2778 // XXX FIXME XXX -- to really be correct here, we should probably | |
2779 // check to see if the assignment conforms, but that seems like more | |
2780 // work than it's worth right now... | |
2781 } | |
2782 else | |
2783 do_matrix_assignment (rhs, args[1], args[2]); | |
2784 break; | |
2785 default: | |
2786 ::error ("too many indices for matrix expression"); | |
2787 break; | |
2788 } | |
2789 } | |
2790 | |
2791 /* | |
2792 * Matrix assignments indexed by a single value. | |
2793 */ | |
2794 void | |
2795 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
2796 tree_constant& i_arg) | |
2797 { | |
2798 int nr = rows (); | |
2799 int nc = columns (); | |
2800 | |
2801 if (user_pref.do_fortran_indexing || nr <= 1 || nc <= 1) | |
2802 { | |
2803 if (i_arg.is_empty ()) | |
2804 { | |
2805 if (! rhs.is_empty ()) | |
2806 { | |
2807 ::error ("in assignment expression, matrix index is empty but"); | |
2808 ::error ("right hand side is not an empty matrix"); | |
2809 } | |
2810 // XXX FIXME XXX -- to really be correct here, we should probably | |
2811 // check to see if the assignment conforms, but that seems like more | |
2812 // work than it's worth right now... | |
2813 | |
2814 // The assignment functions can't handle empty matrices, so don't let | |
2815 // any pass through here. | |
2816 return; | |
2817 } | |
2818 | |
2819 // We can't handle the case of assigning to a vector first, since even | |
2820 // then, the two operations are not equivalent. For example, the | |
2821 // expression V(:) = M is handled differently depending on whether the | |
2822 // user specified do_fortran_indexing = "true". | |
2823 | |
2824 if (user_pref.do_fortran_indexing) | |
2825 fortran_style_matrix_assignment (rhs, i_arg); | |
2826 else if (nr <= 1 || nc <= 1) | |
2827 vector_assignment (rhs, i_arg); | |
2828 else | |
2829 panic_impossible (); | |
2830 } | |
2831 else | |
2832 ::error ("single index only valid for row or column vector"); | |
2833 } | |
2834 | |
2835 /* | |
2836 * Fortran-style assignments. Matrices are assumed to be stored in | |
2837 * column-major order and it is ok to use a single index for | |
2838 * multi-dimensional matrices. | |
2839 */ | |
2840 void | |
2841 tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, | |
2842 tree_constant& i_arg) | |
2843 { | |
2844 tree_constant tmp_i = i_arg.make_numeric_or_magic (); | |
2845 | |
2846 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
2847 | |
2848 int nr = rows (); | |
2849 int nc = columns (); | |
2850 | |
2851 int rhs_nr = rhs.rows (); | |
2852 int rhs_nc = rhs.columns (); | |
2853 | |
2854 switch (itype) | |
2855 { | |
2856 case complex_scalar_constant: | |
2857 case scalar_constant: | |
2858 { | |
2859 int i = NINT (tmp_i.double_value ()); | |
2860 int idx = i - 1; | |
2861 | |
2862 if (rhs_nr == 0 && rhs_nc == 0) | |
2863 { | |
2864 if (idx < nr * nc) | |
2865 { | |
2866 convert_to_row_or_column_vector (); | |
2867 | |
2868 nr = rows (); | |
2869 nc = columns (); | |
2870 | |
2871 if (nr == 1) | |
2872 delete_column (idx); | |
2873 else if (nc == 1) | |
2874 delete_row (idx); | |
2875 else | |
2876 panic_impossible (); | |
2877 } | |
2878 return; | |
2879 } | |
2880 | |
2881 if (index_check (idx, "") < 0) | |
2882 return; | |
2883 | |
2884 if (nr <= 1 || nc <= 1) | |
2885 { | |
2886 maybe_resize (idx); | |
2887 if (error_state) | |
2888 return; | |
2889 } | |
2890 else if (range_max_check (idx, nr * nc) < 0) | |
2891 return; | |
2892 | |
2893 nr = rows (); | |
2894 nc = columns (); | |
2895 | |
2896 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) | |
2897 { | |
2898 ::error ("for A(int) = X: X must be a scalar"); | |
2899 return; | |
2900 } | |
2901 int ii = fortran_row (i, nr) - 1; | |
2902 int jj = fortran_column (i, nr) - 1; | |
2903 do_matrix_assignment (rhs, ii, jj); | |
2904 } | |
2905 break; | |
2906 case complex_matrix_constant: | |
2907 case matrix_constant: | |
2908 { | |
2909 Matrix mi = tmp_i.matrix_value (); | |
2910 int len = nr * nc; | |
2911 idx_vector ii (mi, 1, "", len); // Always do fortran indexing here... | |
2912 if (! ii) | |
2913 return; | |
2914 | |
2915 if (rhs_nr == 0 && rhs_nc == 0) | |
2916 { | |
2917 ii.sort_uniq (); | |
2918 int num_to_delete = 0; | |
2919 for (int i = 0; i < ii.length (); i++) | |
2920 { | |
2921 if (ii.elem (i) < len) | |
2922 num_to_delete++; | |
2923 else | |
2924 break; | |
2925 } | |
2926 | |
2927 if (num_to_delete > 0) | |
2928 { | |
2929 if (num_to_delete != ii.length ()) | |
2930 ii.shorten (num_to_delete); | |
2931 | |
2932 convert_to_row_or_column_vector (); | |
2933 | |
2934 nr = rows (); | |
2935 nc = columns (); | |
2936 | |
2937 if (nr == 1) | |
2938 delete_columns (ii); | |
2939 else if (nc == 1) | |
2940 delete_rows (ii); | |
2941 else | |
2942 panic_impossible (); | |
2943 } | |
2944 return; | |
2945 } | |
2946 | |
2947 if (nr <= 1 || nc <= 1) | |
2948 { | |
2949 maybe_resize (ii.max ()); | |
2950 if (error_state) | |
2951 return; | |
2952 } | |
2953 else if (range_max_check (ii.max (), len) < 0) | |
2954 return; | |
2955 | |
2956 int ilen = ii.capacity (); | |
2957 | |
2958 if (ilen != rhs_nr * rhs_nc) | |
2959 { | |
2960 ::error ("A(matrix) = X: X and matrix must have the same number"); | |
2961 ::error ("of elements"); | |
2962 } | |
2963 else if (ilen == 1 && rhs.is_scalar_type ()) | |
2964 { | |
2965 int nr = rows (); | |
2966 int idx = ii.elem (0); | |
2967 int ii = fortran_row (idx + 1, nr) - 1; | |
2968 int jj = fortran_column (idx + 1, nr) - 1; | |
2969 | |
2970 if (rhs.const_type () == scalar_constant) | |
2971 matrix->elem (ii, jj) = rhs.double_value (); | |
2972 else if (rhs.const_type () == complex_scalar_constant) | |
2973 complex_matrix->elem (ii, jj) = rhs.complex_value (); | |
2974 else | |
2975 panic_impossible (); | |
2976 } | |
2977 else | |
2978 fortran_style_matrix_assignment (rhs, ii); | |
2979 } | |
2980 break; | |
2981 case string_constant: | |
2982 gripe_string_invalid (); | |
2983 break; | |
2984 case range_constant: | |
2985 gripe_range_invalid (); | |
2986 break; | |
2987 case magic_colon: | |
2988 // a(:) = [] is equivalent to a(:,:) = foo. | |
2989 if (rhs_nr == 0 && rhs_nc == 0) | |
2990 do_matrix_assignment (rhs, magic_colon, magic_colon); | |
2991 else | |
2992 fortran_style_matrix_assignment (rhs, magic_colon); | |
2993 break; | |
2994 default: | |
2995 panic_impossible (); | |
2996 break; | |
2997 } | |
2998 } | |
2999 | |
3000 /* | |
3001 * Fortran-style assignment for vector index. | |
3002 */ | |
3003 void | |
3004 tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, | |
3005 idx_vector& i) | |
3006 { | |
3007 assert (rhs.is_matrix_type ()); | |
3008 | |
3009 int ilen = i.capacity (); | |
3010 | |
3011 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
3012 | |
3013 int len = rhs_nr * rhs_nc; | |
3014 | |
3015 if (len == ilen) | |
3016 { | |
3017 int nr = rows (); | |
3018 if (rhs.const_type () == matrix_constant) | |
3019 { | |
3020 double *cop_out = rhs_m.fortran_vec (); | |
3021 for (int k = 0; k < len; k++) | |
3022 { | |
3023 int ii = fortran_row (i.elem (k) + 1, nr) - 1; | |
3024 int jj = fortran_column (i.elem (k) + 1, nr) - 1; | |
3025 | |
3026 matrix->elem (ii, jj) = *cop_out++; | |
3027 } | |
3028 } | |
3029 else | |
3030 { | |
3031 Complex *cop_out = rhs_cm.fortran_vec (); | |
3032 for (int k = 0; k < len; k++) | |
3033 { | |
3034 int ii = fortran_row (i.elem (k) + 1, nr) - 1; | |
3035 int jj = fortran_column (i.elem (k) + 1, nr) - 1; | |
3036 | |
3037 complex_matrix->elem (ii, jj) = *cop_out++; | |
3038 } | |
3039 } | |
3040 } | |
3041 else | |
3042 ::error ("number of rows and columns must match for indexed assignment"); | |
3043 } | |
3044 | |
3045 /* | |
3046 * Fortran-style assignment for colon index. | |
3047 */ | |
3048 void | |
3049 tree_constant_rep::fortran_style_matrix_assignment | |
3050 (tree_constant& rhs, tree_constant_rep::constant_type mci) | |
3051 { | |
3052 assert (rhs.is_matrix_type () && mci == tree_constant_rep::magic_colon); | |
3053 | |
3054 int nr = rows (); | |
3055 int nc = columns (); | |
3056 | |
3057 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
3058 | |
3059 int rhs_size = rhs_nr * rhs_nc; | |
3060 if (rhs_size == 0) | |
3061 { | |
3062 if (rhs.const_type () == matrix_constant) | |
3063 { | |
3064 delete matrix; | |
3065 matrix = new Matrix (0, 0); | |
3066 return; | |
3067 } | |
3068 else | |
3069 panic_impossible (); | |
3070 } | |
3071 else if (nr*nc != rhs_size) | |
3072 { | |
3073 ::error ("A(:) = X: X and A must have the same number of elements"); | |
3074 return; | |
3075 } | |
3076 | |
3077 if (rhs.const_type () == matrix_constant) | |
3078 { | |
3079 double *cop_out = rhs_m.fortran_vec (); | |
3080 for (int j = 0; j < nc; j++) | |
3081 for (int i = 0; i < nr; i++) | |
3082 matrix->elem (i, j) = *cop_out++; | |
3083 } | |
3084 else | |
3085 { | |
3086 Complex *cop_out = rhs_cm.fortran_vec (); | |
3087 for (int j = 0; j < nc; j++) | |
3088 for (int i = 0; i < nr; i++) | |
3089 complex_matrix->elem (i, j) = *cop_out++; | |
3090 } | |
3091 } | |
3092 | |
3093 /* | |
3094 * Assignments to vectors. Hand off to other functions once we know | |
3095 * what kind of index we have. For a colon, it is the same as | |
3096 * assignment to a matrix indexed by two colons. | |
3097 */ | |
3098 void | |
3099 tree_constant_rep::vector_assignment (tree_constant& rhs, tree_constant& i_arg) | |
3100 { | |
3101 int nr = rows (); | |
3102 int nc = columns (); | |
3103 | |
3104 assert ((nr == 1 || nc == 1 || (nr == 0 && nc == 0)) | |
3105 && ! user_pref.do_fortran_indexing); | |
3106 | |
3107 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); | |
3108 | |
3109 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
3110 | |
3111 switch (itype) | |
3112 { | |
3113 case complex_scalar_constant: | |
3114 case scalar_constant: | |
3115 { | |
3116 int i = tree_to_mat_idx (tmp_i.double_value ()); | |
3117 if (index_check (i, "") < 0) | |
3118 return; | |
3119 do_vector_assign (rhs, i); | |
3120 } | |
3121 break; | |
3122 case complex_matrix_constant: | |
3123 case matrix_constant: | |
3124 { | |
3125 Matrix mi = tmp_i.matrix_value (); | |
3126 int len = nr * nc; | |
3127 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); | |
3128 if (! iv) | |
3129 return; | |
3130 | |
3131 do_vector_assign (rhs, iv); | |
3132 } | |
3133 break; | |
3134 case string_constant: | |
3135 gripe_string_invalid (); | |
3136 break; | |
3137 case range_constant: | |
3138 { | |
3139 Range ri = tmp_i.range_value (); | |
3140 int len = nr * nc; | |
3141 if (len == 2 && is_zero_one (ri)) | |
3142 { | |
3143 do_vector_assign (rhs, 1); | |
3144 } | |
3145 else if (len == 2 && is_one_zero (ri)) | |
3146 { | |
3147 do_vector_assign (rhs, 0); | |
3148 } | |
3149 else | |
3150 { | |
3151 if (index_check (ri, "") < 0) | |
3152 return; | |
3153 do_vector_assign (rhs, ri); | |
3154 } | |
3155 } | |
3156 break; | |
3157 case magic_colon: | |
3158 { | |
3159 int rhs_nr = rhs.rows (); | |
3160 int rhs_nc = rhs.columns (); | |
3161 | |
3162 if (! indexed_assign_conforms (nr, nc, rhs_nr, rhs_nc)) | |
3163 { | |
3164 ::error ("A(:) = X: X and A must have the same dimensions"); | |
3165 return; | |
3166 } | |
3167 do_matrix_assignment (rhs, magic_colon, magic_colon); | |
3168 } | |
3169 break; | |
3170 default: | |
3171 panic_impossible (); | |
3172 break; | |
3173 } | |
3174 } | |
3175 | |
3176 /* | |
3177 * Check whether an indexed assignment to a vector is valid. | |
3178 */ | |
3179 void | |
3180 tree_constant_rep::check_vector_assign (int rhs_nr, int rhs_nc, | |
3181 int ilen, const char *rm) | |
3182 { | |
3183 int nr = rows (); | |
3184 int nc = columns (); | |
3185 | |
3186 if ((nr == 1 && nc == 1) || nr == 0 || nc == 0) // No orientation. | |
3187 { | |
3188 if (! (ilen == rhs_nr || ilen == rhs_nc)) | |
3189 { | |
3190 ::error ("A(%s) = X: X and %s must have the same number of elements", | |
3191 rm, rm); | |
3192 } | |
3193 } | |
3194 else if (nr == 1) // Preserve current row orientation. | |
3195 { | |
3196 if (! (rhs_nr == 1 && rhs_nc == ilen)) | |
3197 { | |
3198 ::error ("A(%s) = X: where A is a row vector, X must also be a", rm); | |
3199 ::error ("row vector with the same number of elements as %s", rm); | |
3200 } | |
3201 } | |
3202 else if (nc == 1) // Preserve current column orientation. | |
3203 { | |
3204 if (! (rhs_nc == 1 && rhs_nr == ilen)) | |
3205 { | |
3206 ::error ("A(%s) = X: where A is a column vector, X must also be", rm); | |
3207 ::error ("a column vector with the same number of elements as %s", rm); | |
3208 } | |
3209 } | |
3210 else | |
3211 panic_impossible (); | |
3212 } | |
3213 | |
3214 /* | |
3215 * Assignment to a vector with an integer index. | |
3216 */ | |
3217 void | |
3218 tree_constant_rep::do_vector_assign (tree_constant& rhs, int i) | |
3219 { | |
3220 int rhs_nr = rhs.rows (); | |
3221 int rhs_nc = rhs.columns (); | |
3222 | |
3223 if (indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) | |
3224 { | |
3225 maybe_resize (i); | |
3226 if (error_state) | |
3227 return; | |
3228 | |
3229 int nr = rows (); | |
3230 int nc = columns (); | |
3231 | |
3232 if (nr == 1) | |
3233 { | |
3234 REP_ELEM_ASSIGN (0, i, rhs.double_value (), rhs.complex_value (), | |
3235 rhs.is_real_type ()); | |
3236 } | |
3237 else if (nc == 1) | |
3238 { | |
3239 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), rhs.complex_value (), | |
3240 rhs.is_real_type ()); | |
3241 } | |
3242 else | |
3243 panic_impossible (); | |
3244 } | |
3245 else if (rhs_nr == 0 && rhs_nc == 0) | |
3246 { | |
3247 int nr = rows (); | |
3248 int nc = columns (); | |
3249 | |
3250 int len = nr > nc ? nr : nc; | |
3251 | |
3252 if (i < 0 || i >= len) | |
3253 { | |
3254 ::error ("A(int) = []: index out of range"); | |
3255 return; | |
3256 } | |
3257 | |
3258 if (nr == 1) | |
3259 delete_column (i); | |
3260 else if (nc == 1) | |
3261 delete_row (i); | |
3262 else | |
3263 panic_impossible (); | |
3264 } | |
3265 else | |
3266 { | |
3267 ::error ("for A(int) = X: X must be a scalar"); | |
3268 return; | |
3269 } | |
3270 } | |
3271 | |
3272 /* | |
3273 * Assignment to a vector with a vector index. | |
3274 */ | |
3275 void | |
3276 tree_constant_rep::do_vector_assign (tree_constant& rhs, idx_vector& iv) | |
3277 { | |
3278 if (rhs.is_zero_by_zero ()) | |
3279 { | |
3280 int nr = rows (); | |
3281 int nc = columns (); | |
3282 | |
3283 int len = nr > nc ? nr : nc; | |
3284 | |
3285 if (iv.max () >= len) | |
3286 { | |
3287 ::error ("A(matrix) = []: index out of range"); | |
3288 return; | |
3289 } | |
3290 | |
3291 if (nr == 1) | |
3292 delete_columns (iv); | |
3293 else if (nc == 1) | |
3294 delete_rows (iv); | |
3295 else | |
3296 panic_impossible (); | |
3297 } | |
3298 else if (rhs.is_scalar_type ()) | |
3299 { | |
3300 int nr = rows (); | |
3301 int nc = columns (); | |
3302 | |
3303 if (iv.capacity () == 1) | |
3304 { | |
3305 int idx = iv.elem (0); | |
3306 | |
3307 if (nr == 1) | |
3308 { | |
3309 REP_ELEM_ASSIGN (0, idx, rhs.double_value (), | |
3310 rhs.complex_value (), rhs.is_real_type ()); | |
3311 } | |
3312 else if (nc == 1) | |
3313 { | |
3314 REP_ELEM_ASSIGN (idx, 0, rhs.double_value (), | |
3315 rhs.complex_value (), rhs.is_real_type ()); | |
3316 } | |
3317 else | |
3318 panic_impossible (); | |
3319 } | |
3320 else | |
3321 { | |
3322 if (nr == 1) | |
3323 { | |
3324 ::error ("A(matrix) = X: where A is a row vector, X must also be a"); | |
3325 ::error ("row vector with the same number of elements as matrix"); | |
3326 } | |
3327 else if (nc == 1) | |
3328 { | |
3329 ::error ("A(matrix) = X: where A is a column vector, X must also be a"); | |
3330 ::error ("column vector with the same number of elements as matrix"); | |
3331 } | |
3332 else | |
3333 panic_impossible (); | |
3334 } | |
3335 } | |
3336 else if (rhs.is_matrix_type ()) | |
3337 { | |
3338 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
3339 | |
3340 int ilen = iv.capacity (); | |
3341 check_vector_assign (rhs_nr, rhs_nc, ilen, "matrix"); | |
3342 if (error_state) | |
3343 return; | |
3344 | |
3345 force_orient f_orient = no_orient; | |
3346 if (rhs_nr == 1 && rhs_nc != 1) | |
3347 f_orient = row_orient; | |
3348 else if (rhs_nc == 1 && rhs_nr != 1) | |
3349 f_orient = column_orient; | |
3350 | |
3351 maybe_resize (iv.max (), f_orient); | |
3352 if (error_state) | |
3353 return; | |
3354 | |
3355 int nr = rows (); | |
3356 int nc = columns (); | |
3357 | |
3358 if (nr == 1) | |
3359 { | |
3360 for (int i = 0; i < iv.capacity (); i++) | |
3361 REP_ELEM_ASSIGN (0, iv.elem (i), rhs_m.elem (0, i), | |
3362 rhs_cm.elem (0, i), rhs.is_real_type ()); | |
3363 } | |
3364 else if (nc == 1) | |
3365 { | |
3366 for (int i = 0; i < iv.capacity (); i++) | |
3367 REP_ELEM_ASSIGN (iv.elem (i), 0, rhs_m.elem (i, 0), | |
3368 rhs_cm.elem (i, 0), rhs.is_real_type ()); | |
3369 } | |
3370 else | |
3371 panic_impossible (); | |
3372 } | |
3373 else | |
3374 panic_impossible (); | |
3375 } | |
3376 | |
3377 /* | |
3378 * Assignment to a vector with a range index. | |
3379 */ | |
3380 void | |
3381 tree_constant_rep::do_vector_assign (tree_constant& rhs, Range& ri) | |
3382 { | |
3383 if (rhs.is_zero_by_zero ()) | |
3384 { | |
3385 int nr = rows (); | |
3386 int nc = columns (); | |
3387 | |
3388 int len = nr > nc ? nr : nc; | |
3389 | |
3390 int b = tree_to_mat_idx (ri.min ()); | |
3391 int l = tree_to_mat_idx (ri.max ()); | |
3392 if (b < 0 || l >= len) | |
3393 { | |
3394 ::error ("A(range) = []: index out of range"); | |
3395 return; | |
3396 } | |
3397 | |
3398 if (nr == 1) | |
3399 delete_columns (ri); | |
3400 else if (nc == 1) | |
3401 delete_rows (ri); | |
3402 else | |
3403 panic_impossible (); | |
3404 } | |
3405 else if (rhs.is_scalar_type ()) | |
3406 { | |
3407 int nr = rows (); | |
3408 int nc = columns (); | |
3409 | |
3410 if (nr == 1) | |
3411 { | |
3412 ::error ("A(range) = X: where A is a row vector, X must also be a"); | |
3413 ::error ("row vector with the same number of elements as range"); | |
3414 } | |
3415 else if (nc == 1) | |
3416 { | |
3417 ::error ("A(range) = X: where A is a column vector, X must also be a"); | |
3418 ::error ("column vector with the same number of elements as range"); | |
3419 } | |
3420 else | |
3421 panic_impossible (); | |
3422 } | |
3423 else if (rhs.is_matrix_type ()) | |
3424 { | |
3425 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
3426 | |
3427 int ilen = ri.nelem (); | |
3428 check_vector_assign (rhs_nr, rhs_nc, ilen, "range"); | |
3429 if (error_state) | |
3430 return; | |
3431 | |
3432 force_orient f_orient = no_orient; | |
3433 if (rhs_nr == 1 && rhs_nc != 1) | |
3434 f_orient = row_orient; | |
3435 else if (rhs_nc == 1 && rhs_nr != 1) | |
3436 f_orient = column_orient; | |
3437 | |
3438 maybe_resize (tree_to_mat_idx (ri.max ()), f_orient); | |
3439 if (error_state) | |
3440 return; | |
3441 | |
3442 int nr = rows (); | |
3443 int nc = columns (); | |
3444 | |
3445 double b = ri.base (); | |
3446 double increment = ri.inc (); | |
3447 | |
3448 if (nr == 1) | |
3449 { | |
3450 for (int i = 0; i < ri.nelem (); i++) | |
3451 { | |
3452 double tmp = b + i * increment; | |
3453 int col = tree_to_mat_idx (tmp); | |
3454 REP_ELEM_ASSIGN (0, col, rhs_m.elem (0, i), rhs_cm.elem (0, i), | |
3455 rhs.is_real_type ()); | |
3456 } | |
3457 } | |
3458 else if (nc == 1) | |
3459 { | |
3460 for (int i = 0; i < ri.nelem (); i++) | |
3461 { | |
3462 double tmp = b + i * increment; | |
3463 int row = tree_to_mat_idx (tmp); | |
3464 REP_ELEM_ASSIGN (row, 0, rhs_m.elem (i, 0), rhs_cm.elem (i, 0), | |
3465 rhs.is_real_type ()); | |
3466 } | |
3467 } | |
3468 else | |
3469 panic_impossible (); | |
3470 } | |
3471 else | |
3472 panic_impossible (); | |
3473 } | |
3474 | |
3475 /* | |
3476 * Matrix assignment indexed by two values. This function determines | |
3477 * the type of the first arugment, checks as much as possible, and | |
3478 * then calls one of a set of functions to handle the specific cases: | |
3479 * | |
3480 * M (integer, arg2) = RHS (MA1) | |
3481 * M (vector, arg2) = RHS (MA2) | |
3482 * M (range, arg2) = RHS (MA3) | |
3483 * M (colon, arg2) = RHS (MA4) | |
3484 * | |
3485 * Each of those functions determines the type of the second argument | |
3486 * and calls another function to handle the real work of doing the | |
3487 * assignment. | |
3488 */ | |
3489 void | |
3490 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
3491 tree_constant& i_arg, | |
3492 tree_constant& j_arg) | |
3493 { | |
3494 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); | |
3495 | |
3496 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
3497 | |
3498 switch (itype) | |
3499 { | |
3500 case complex_scalar_constant: | |
3501 case scalar_constant: | |
3502 { | |
3503 int i = tree_to_mat_idx (tmp_i.double_value ()); | |
3504 if (index_check (i, "row") < 0) | |
3505 return; | |
3506 do_matrix_assignment (rhs, i, j_arg); | |
3507 } | |
3508 break; | |
3509 case complex_matrix_constant: | |
3510 case matrix_constant: | |
3511 { | |
3512 Matrix mi = tmp_i.matrix_value (); | |
3513 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); | |
3514 if (! iv) | |
3515 return; | |
3516 | |
3517 do_matrix_assignment (rhs, iv, j_arg); | |
3518 } | |
3519 break; | |
3520 case string_constant: | |
3521 gripe_string_invalid (); | |
3522 break; | |
3523 case range_constant: | |
3524 { | |
3525 Range ri = tmp_i.range_value (); | |
3526 int nr = rows (); | |
3527 if (nr == 2 && is_zero_one (ri)) | |
3528 { | |
3529 do_matrix_assignment (rhs, 1, j_arg); | |
3530 } | |
3531 else if (nr == 2 && is_one_zero (ri)) | |
3532 { | |
3533 do_matrix_assignment (rhs, 0, j_arg); | |
3534 } | |
3535 else | |
3536 { | |
3537 if (index_check (ri, "row") < 0) | |
3538 return; | |
3539 do_matrix_assignment (rhs, ri, j_arg); | |
3540 } | |
3541 } | |
3542 break; | |
3543 case magic_colon: | |
3544 do_matrix_assignment (rhs, magic_colon, j_arg); | |
3545 break; | |
3546 default: | |
3547 panic_impossible (); | |
3548 break; | |
3549 } | |
3550 } | |
3551 | |
3552 /* MA1 */ | |
3553 void | |
3554 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, | |
3555 tree_constant& j_arg) | |
3556 { | |
3557 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
3558 | |
3559 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
3560 | |
3561 int rhs_nr = rhs.rows (); | |
3562 int rhs_nc = rhs.columns (); | |
3563 | |
3564 switch (jtype) | |
3565 { | |
3566 case complex_scalar_constant: | |
3567 case scalar_constant: | |
3568 { | |
3569 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
3570 if (index_check (j, "column") < 0) | |
3571 return; | |
3572 if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) | |
3573 { | |
3574 ::error ("A(int,int) = X, X must be a scalar"); | |
3575 return; | |
3576 } | |
3577 maybe_resize (i, j); | |
3578 if (error_state) | |
3579 return; | |
3580 | |
3581 do_matrix_assignment (rhs, i, j); | |
3582 } | |
3583 break; | |
3584 case complex_matrix_constant: | |
3585 case matrix_constant: | |
3586 { | |
3587 Matrix mj = tmp_j.matrix_value (); | |
3588 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", | |
3589 columns ()); | |
3590 if (! jv) | |
3591 return; | |
3592 | |
3593 if (! indexed_assign_conforms (1, jv.capacity (), rhs_nr, rhs_nc)) | |
3594 { | |
3595 ::error ("A(int,matrix) = X: X must be a row vector with the same"); | |
3596 ::error ("number of elements as matrix"); | |
3597 return; | |
3598 } | |
3599 maybe_resize (i, jv.max ()); | |
3600 if (error_state) | |
3601 return; | |
3602 | |
3603 do_matrix_assignment (rhs, i, jv); | |
3604 } | |
3605 break; | |
3606 case string_constant: | |
3607 gripe_string_invalid (); | |
3608 break; | |
3609 case range_constant: | |
3610 { | |
3611 Range rj = tmp_j.range_value (); | |
3612 if (! indexed_assign_conforms (1, rj.nelem (), rhs_nr, rhs_nc)) | |
3613 { | |
3614 ::error ("A(int,range) = X: X must be a row vector with the same"); | |
3615 ::error ("number of elements as range"); | |
3616 return; | |
3617 } | |
3618 | |
3619 int nc = columns (); | |
3620 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) | |
3621 { | |
3622 do_matrix_assignment (rhs, i, 1); | |
3623 } | |
3624 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) | |
3625 { | |
3626 do_matrix_assignment (rhs, i, 0); | |
3627 } | |
3628 else | |
3629 { | |
3630 if (index_check (rj, "column") < 0) | |
3631 return; | |
3632 maybe_resize (i, tree_to_mat_idx (rj.max ())); | |
3633 if (error_state) | |
3634 return; | |
3635 | |
3636 do_matrix_assignment (rhs, i, rj); | |
3637 } | |
3638 } | |
3639 break; | |
3640 case magic_colon: | |
3641 { | |
3642 int nc = columns (); | |
3643 int nr = rows (); | |
3644 if (nc == 0 && nr == 0 && rhs_nr == 1) | |
3645 { | |
3646 if (rhs.is_complex_type ()) | |
3647 { | |
3648 complex_matrix = new ComplexMatrix (); | |
3649 type_tag = complex_matrix_constant; | |
3650 } | |
3651 else | |
3652 { | |
3653 matrix = new Matrix (); | |
3654 type_tag = matrix_constant; | |
3655 } | |
3656 maybe_resize (i, rhs_nc-1); | |
3657 if (error_state) | |
3658 return; | |
3659 } | |
3660 else if (indexed_assign_conforms (1, nc, rhs_nr, rhs_nc)) | |
3661 { | |
3662 maybe_resize (i, nc-1); | |
3663 if (error_state) | |
3664 return; | |
3665 } | |
3666 else if (rhs_nr == 0 && rhs_nc == 0) | |
3667 { | |
3668 if (i < 0 || i >= nr) | |
3669 { | |
3670 ::error ("A(int,:) = []: row index out of range"); | |
3671 return; | |
3672 } | |
3673 } | |
3674 else | |
3675 { | |
3676 ::error ("A(int,:) = X: X must be a row vector with the same"); | |
3677 ::error ("number of columns as A"); | |
3678 return; | |
3679 } | |
3680 | |
3681 do_matrix_assignment (rhs, i, magic_colon); | |
3682 } | |
3683 break; | |
3684 default: | |
3685 panic_impossible (); | |
3686 break; | |
3687 } | |
3688 } | |
3689 | |
3690 /* MA2 */ | |
3691 void | |
3692 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, | |
3693 tree_constant& j_arg) | |
3694 { | |
3695 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
3696 | |
3697 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
3698 | |
3699 int rhs_nr = rhs.rows (); | |
3700 int rhs_nc = rhs.columns (); | |
3701 | |
3702 switch (jtype) | |
3703 { | |
3704 case complex_scalar_constant: | |
3705 case scalar_constant: | |
3706 { | |
3707 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
3708 if (index_check (j, "column") < 0) | |
3709 return; | |
3710 if (! indexed_assign_conforms (iv.capacity (), 1, rhs_nr, rhs_nc)) | |
3711 { | |
3712 ::error ("A(matrix,int) = X: X must be a column vector with the"); | |
3713 ::error ("same number of elements as matrix"); | |
3714 return; | |
3715 } | |
3716 maybe_resize (iv.max (), j); | |
3717 if (error_state) | |
3718 return; | |
3719 | |
3720 do_matrix_assignment (rhs, iv, j); | |
3721 } | |
3722 break; | |
3723 case complex_matrix_constant: | |
3724 case matrix_constant: | |
3725 { | |
3726 Matrix mj = tmp_j.matrix_value (); | |
3727 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", | |
3728 columns ()); | |
3729 if (! jv) | |
3730 return; | |
3731 | |
3732 if (! indexed_assign_conforms (iv.capacity (), jv.capacity (), | |
3733 rhs_nr, rhs_nc)) | |
3734 { | |
3735 ::error ("A(r_mat,c_mat) = X: the number of rows in X must match"); | |
3736 ::error ("the number of elements in r_mat and the number of"); | |
3737 ::error ("columns in X must match the number of elements in c_mat"); | |
3738 return; | |
3739 } | |
3740 maybe_resize (iv.max (), jv.max ()); | |
3741 if (error_state) | |
3742 return; | |
3743 | |
3744 do_matrix_assignment (rhs, iv, jv); | |
3745 } | |
3746 break; | |
3747 case string_constant: | |
3748 gripe_string_invalid (); | |
3749 break; | |
3750 case range_constant: | |
3751 { | |
3752 Range rj = tmp_j.range_value (); | |
3753 if (! indexed_assign_conforms (iv.capacity (), rj.nelem (), | |
3754 rhs_nr, rhs_nc)) | |
3755 { | |
3756 ::error ("A(matrix,range) = X: the number of rows in X must match"); | |
3757 ::error ("the number of elements in matrix and the number of"); | |
3758 ::error ("columns in X must match the number of elements in range"); | |
3759 return; | |
3760 } | |
3761 | |
3762 int nc = columns (); | |
3763 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) | |
3764 { | |
3765 do_matrix_assignment (rhs, iv, 1); | |
3766 } | |
3767 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) | |
3768 { | |
3769 do_matrix_assignment (rhs, iv, 0); | |
3770 } | |
3771 else | |
3772 { | |
3773 if (index_check (rj, "column") < 0) | |
3774 return; | |
3775 maybe_resize (iv.max (), tree_to_mat_idx (rj.max ())); | |
3776 if (error_state) | |
3777 return; | |
3778 | |
3779 do_matrix_assignment (rhs, iv, rj); | |
3780 } | |
3781 } | |
3782 break; | |
3783 case magic_colon: | |
3784 { | |
3785 int nc = columns (); | |
3786 int new_nc = nc; | |
3787 if (nc == 0) | |
3788 new_nc = rhs_nc; | |
3789 | |
3790 if (indexed_assign_conforms (iv.capacity (), new_nc, | |
3791 rhs_nr, rhs_nc)) | |
3792 { | |
3793 maybe_resize (iv.max (), new_nc-1); | |
3794 if (error_state) | |
3795 return; | |
3796 } | |
3797 else if (rhs_nr == 0 && rhs_nc == 0) | |
3798 { | |
3799 if (iv.max () >= rows ()) | |
3800 { | |
3801 ::error ("A(matrix,:) = []: row index out of range"); | |
3802 return; | |
3803 } | |
3804 } | |
3805 else | |
3806 { | |
3807 ::error ("A(matrix,:) = X: the number of rows in X must match the"); | |
3808 ::error ("number of elements in matrix, and the number of columns"); | |
3809 ::error ("in X must match the number of columns in A"); | |
3810 return; | |
3811 } | |
3812 | |
3813 do_matrix_assignment (rhs, iv, magic_colon); | |
3814 } | |
3815 break; | |
3816 default: | |
3817 panic_impossible (); | |
3818 break; | |
3819 } | |
3820 } | |
3821 | |
3822 /* MA3 */ | |
3823 void | |
3824 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
3825 Range& ri, tree_constant& j_arg) | |
3826 { | |
3827 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
3828 | |
3829 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
3830 | |
3831 int rhs_nr = rhs.rows (); | |
3832 int rhs_nc = rhs.columns (); | |
3833 | |
3834 switch (jtype) | |
3835 { | |
3836 case complex_scalar_constant: | |
3837 case scalar_constant: | |
3838 { | |
3839 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
3840 if (index_check (j, "column") < 0) | |
3841 return; | |
3842 if (! indexed_assign_conforms (ri.nelem (), 1, rhs_nr, rhs_nc)) | |
3843 { | |
3844 ::error ("A(range,int) = X: X must be a column vector with the"); | |
3845 ::error ("same number of elements as range"); | |
3846 return; | |
3847 } | |
3848 maybe_resize (tree_to_mat_idx (ri.max ()), j); | |
3849 if (error_state) | |
3850 return; | |
3851 | |
3852 do_matrix_assignment (rhs, ri, j); | |
3853 } | |
3854 break; | |
3855 case complex_matrix_constant: | |
3856 case matrix_constant: | |
3857 { | |
3858 Matrix mj = tmp_j.matrix_value (); | |
3859 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", | |
3860 columns ()); | |
3861 if (! jv) | |
3862 return; | |
3863 | |
3864 if (! indexed_assign_conforms (ri.nelem (), jv.capacity (), | |
3865 rhs_nr, rhs_nc)) | |
3866 { | |
3867 ::error ("A(range,matrix) = X: the number of rows in X must match"); | |
3868 ::error ("the number of elements in range and the number of"); | |
3869 ::error ("columns in X must match the number of elements in matrix"); | |
3870 return; | |
3871 } | |
3872 maybe_resize (tree_to_mat_idx (ri.max ()), jv.max ()); | |
3873 if (error_state) | |
3874 return; | |
3875 | |
3876 do_matrix_assignment (rhs, ri, jv); | |
3877 } | |
3878 break; | |
3879 case string_constant: | |
3880 gripe_string_invalid (); | |
3881 break; | |
3882 case range_constant: | |
3883 { | |
3884 Range rj = tmp_j.range_value (); | |
3885 if (! indexed_assign_conforms (ri.nelem (), rj.nelem (), | |
3886 rhs_nr, rhs_nc)) | |
3887 { | |
3888 ::error ("A(r_range,c_range) = X: the number of rows in X must"); | |
3889 ::error ("match the number of elements in r_range and the number"); | |
3890 ::error ("of columns in X must match the number of elements in"); | |
3891 ::error ("c_range"); | |
3892 return; | |
3893 } | |
3894 | |
3895 int nc = columns (); | |
3896 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) | |
3897 { | |
3898 do_matrix_assignment (rhs, ri, 1); | |
3899 } | |
3900 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) | |
3901 { | |
3902 do_matrix_assignment (rhs, ri, 0); | |
3903 } | |
3904 else | |
3905 { | |
3906 if (index_check (rj, "column") < 0) | |
3907 return; | |
3908 | |
3909 maybe_resize (tree_to_mat_idx (ri.max ()), | |
3910 tree_to_mat_idx (rj.max ())); | |
3911 | |
3912 if (error_state) | |
3913 return; | |
3914 | |
3915 do_matrix_assignment (rhs, ri, rj); | |
3916 } | |
3917 } | |
3918 break; | |
3919 case magic_colon: | |
3920 { | |
3921 int nc = columns (); | |
3922 int new_nc = nc; | |
3923 if (nc == 0) | |
3924 new_nc = rhs_nc; | |
3925 | |
3926 if (indexed_assign_conforms (ri.nelem (), new_nc, rhs_nr, rhs_nc)) | |
3927 { | |
3928 maybe_resize (tree_to_mat_idx (ri.max ()), new_nc-1); | |
3929 if (error_state) | |
3930 return; | |
3931 } | |
3932 else if (rhs_nr == 0 && rhs_nc == 0) | |
3933 { | |
3934 int b = tree_to_mat_idx (ri.min ()); | |
3935 int l = tree_to_mat_idx (ri.max ()); | |
3936 if (b < 0 || l >= rows ()) | |
3937 { | |
3938 ::error ("A(range,:) = []: row index out of range"); | |
3939 return; | |
3940 } | |
3941 } | |
3942 else | |
3943 { | |
3944 ::error ("A(range,:) = X: the number of rows in X must match the"); | |
3945 ::error ("number of elements in range, and the number of columns"); | |
3946 ::error ("in X must match the number of columns in A"); | |
3947 return; | |
3948 } | |
3949 | |
3950 do_matrix_assignment (rhs, ri, magic_colon); | |
3951 } | |
3952 break; | |
3953 default: | |
3954 panic_impossible (); | |
3955 break; | |
3956 } | |
3957 } | |
3958 | |
3959 /* MA4 */ | |
3960 void | |
3961 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
3962 tree_constant_rep::constant_type i, | |
3963 tree_constant& j_arg) | |
3964 { | |
3965 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
3966 | |
3967 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
3968 | |
3969 int rhs_nr = rhs.rows (); | |
3970 int rhs_nc = rhs.columns (); | |
3971 | |
3972 switch (jtype) | |
3973 { | |
3974 case complex_scalar_constant: | |
3975 case scalar_constant: | |
3976 { | |
3977 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
3978 if (index_check (j, "column") < 0) | |
3979 return; | |
3980 int nr = rows (); | |
3981 int nc = columns (); | |
3982 if (nr == 0 && nc == 0 && rhs_nc == 1) | |
3983 { | |
3984 if (rhs.is_complex_type ()) | |
3985 { | |
3986 complex_matrix = new ComplexMatrix (); | |
3987 type_tag = complex_matrix_constant; | |
3988 } | |
3989 else | |
3990 { | |
3991 matrix = new Matrix (); | |
3992 type_tag = matrix_constant; | |
3993 } | |
3994 maybe_resize (rhs_nr-1, j); | |
3995 if (error_state) | |
3996 return; | |
3997 } | |
3998 else if (indexed_assign_conforms (nr, 1, rhs_nr, rhs_nc)) | |
3999 { | |
4000 maybe_resize (nr-1, j); | |
4001 if (error_state) | |
4002 return; | |
4003 } | |
4004 else if (rhs_nr == 0 && rhs_nc == 0) | |
4005 { | |
4006 if (j < 0 || j >= nc) | |
4007 { | |
4008 ::error ("A(:,int) = []: column index out of range"); | |
4009 return; | |
4010 } | |
4011 } | |
4012 else | |
4013 { | |
4014 ::error ("A(:,int) = X: X must be a column vector with the same"); | |
4015 ::error ("number of rows as A"); | |
4016 return; | |
4017 } | |
4018 | |
4019 do_matrix_assignment (rhs, magic_colon, j); | |
4020 } | |
4021 break; | |
4022 case complex_matrix_constant: | |
4023 case matrix_constant: | |
4024 { | |
4025 Matrix mj = tmp_j.matrix_value (); | |
4026 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", | |
4027 columns ()); | |
4028 if (! jv) | |
4029 return; | |
4030 | |
4031 int nr = rows (); | |
4032 int new_nr = nr; | |
4033 if (nr == 0) | |
4034 new_nr = rhs_nr; | |
4035 | |
4036 if (indexed_assign_conforms (new_nr, jv.capacity (), | |
4037 rhs_nr, rhs_nc)) | |
4038 { | |
4039 maybe_resize (new_nr-1, jv.max ()); | |
4040 if (error_state) | |
4041 return; | |
4042 } | |
4043 else if (rhs_nr == 0 && rhs_nc == 0) | |
4044 { | |
4045 if (jv.max () >= columns ()) | |
4046 { | |
4047 ::error ("A(:,matrix) = []: column index out of range"); | |
4048 return; | |
4049 } | |
4050 } | |
4051 else | |
4052 { | |
4053 ::error ("A(:,matrix) = X: the number of rows in X must match the"); | |
4054 ::error ("number of rows in A, and the number of columns in X must"); | |
4055 ::error ("match the number of elements in matrix"); | |
4056 return; | |
4057 } | |
4058 | |
4059 do_matrix_assignment (rhs, magic_colon, jv); | |
4060 } | |
4061 break; | |
4062 case string_constant: | |
4063 gripe_string_invalid (); | |
4064 break; | |
4065 case range_constant: | |
4066 { | |
4067 Range rj = tmp_j.range_value (); | |
4068 int nr = rows (); | |
4069 int new_nr = nr; | |
4070 if (nr == 0) | |
4071 new_nr = rhs_nr; | |
4072 | |
4073 if (indexed_assign_conforms (new_nr, rj.nelem (), rhs_nr, rhs_nc)) | |
4074 { | |
4075 int nc = columns (); | |
4076 if (nc == 2 && is_zero_one (rj) && rhs_nc == 1) | |
4077 { | |
4078 do_matrix_assignment (rhs, magic_colon, 1); | |
4079 } | |
4080 else if (nc == 2 && is_one_zero (rj) && rhs_nc == 1) | |
4081 { | |
4082 do_matrix_assignment (rhs, magic_colon, 0); | |
4083 } | |
4084 else | |
4085 { | |
4086 if (index_check (rj, "column") < 0) | |
4087 return; | |
4088 maybe_resize (new_nr-1, tree_to_mat_idx (rj.max ())); | |
4089 if (error_state) | |
4090 return; | |
4091 } | |
4092 } | |
4093 else if (rhs_nr == 0 && rhs_nc == 0) | |
4094 { | |
4095 int b = tree_to_mat_idx (rj.min ()); | |
4096 int l = tree_to_mat_idx (rj.max ()); | |
4097 if (b < 0 || l >= columns ()) | |
4098 { | |
4099 ::error ("A(:,range) = []: column index out of range"); | |
4100 return; | |
4101 } | |
4102 } | |
4103 else | |
4104 { | |
4105 ::error ("A(:,range) = X: the number of rows in X must match the"); | |
4106 ::error ("number of rows in A, and the number of columns in X"); | |
4107 ::error ("must match the number of elements in range"); | |
4108 return; | |
4109 } | |
4110 | |
4111 do_matrix_assignment (rhs, magic_colon, rj); | |
4112 } | |
4113 break; | |
4114 case magic_colon: | |
4115 // a(:,:) = foo is equivalent to a = foo. | |
4116 do_matrix_assignment (rhs, magic_colon, magic_colon); | |
4117 break; | |
4118 default: | |
4119 panic_impossible (); | |
4120 break; | |
4121 } | |
4122 } | |
4123 | |
4124 /* | |
4125 * Functions that actually handle assignment to a matrix using two | |
4126 * index values. | |
4127 * | |
4128 * idx2 | |
4129 * +---+---+----+----+ | |
4130 * idx1 | i | v | r | c | | |
4131 * ---------+---+---+----+----+ | |
4132 * integer | 1 | 5 | 9 | 13 | | |
4133 * ---------+---+---+----+----+ | |
4134 * vector | 2 | 6 | 10 | 14 | | |
4135 * ---------+---+---+----+----+ | |
4136 * range | 3 | 7 | 11 | 15 | | |
4137 * ---------+---+---+----+----+ | |
4138 * colon | 4 | 8 | 12 | 16 | | |
4139 * ---------+---+---+----+----+ | |
4140 */ | |
4141 | |
4142 /* 1 */ | |
4143 void | |
4144 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, int j) | |
4145 { | |
4146 REP_ELEM_ASSIGN (i, j, rhs.double_value (), rhs.complex_value (), | |
4147 rhs.is_real_type ()); | |
4148 } | |
4149 | |
4150 /* 2 */ | |
4151 void | |
4152 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, | |
4153 idx_vector& jv) | |
4154 { | |
4155 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4156 | |
4157 for (int j = 0; j < jv.capacity (); j++) | |
4158 REP_ELEM_ASSIGN (i, jv.elem (j), rhs_m.elem (0, j), | |
4159 rhs_cm.elem (0, j), rhs.is_real_type ()); | |
4160 } | |
4161 | |
4162 /* 3 */ | |
4163 void | |
4164 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, Range& rj) | |
4165 { | |
4166 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4167 | |
4168 double b = rj.base (); | |
4169 double increment = rj.inc (); | |
4170 | |
4171 for (int j = 0; j < rj.nelem (); j++) | |
4172 { | |
4173 double tmp = b + j * increment; | |
4174 int col = tree_to_mat_idx (tmp); | |
4175 REP_ELEM_ASSIGN (i, col, rhs_m.elem (0, j), rhs_cm.elem (0, j), | |
4176 rhs.is_real_type ()); | |
4177 } | |
4178 } | |
4179 | |
4180 /* 4 */ | |
4181 void | |
4182 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, | |
4183 tree_constant_rep::constant_type mcj) | |
4184 { | |
4185 assert (mcj == magic_colon); | |
4186 | |
4187 int nc = columns (); | |
4188 | |
4189 if (rhs.is_zero_by_zero ()) | |
4190 { | |
4191 delete_row (i); | |
4192 } | |
4193 else if (rhs.is_matrix_type ()) | |
4194 { | |
4195 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4196 | |
4197 for (int j = 0; j < nc; j++) | |
4198 REP_ELEM_ASSIGN (i, j, rhs_m.elem (0, j), rhs_cm.elem (0, j), | |
4199 rhs.is_real_type ()); | |
4200 } | |
4201 else if (rhs.is_scalar_type () && nc == 1) | |
4202 { | |
4203 REP_ELEM_ASSIGN (i, 0, rhs.double_value (), | |
4204 rhs.complex_value (), rhs.is_real_type ()); | |
4205 } | |
4206 else | |
4207 panic_impossible (); | |
4208 } | |
4209 | |
4210 /* 5 */ | |
4211 void | |
4212 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4213 idx_vector& iv, int j) | |
4214 { | |
4215 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4216 | |
4217 for (int i = 0; i < iv.capacity (); i++) | |
4218 { | |
4219 int row = iv.elem (i); | |
4220 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), | |
4221 rhs_cm.elem (i, 0), rhs.is_real_type ()); | |
4222 } | |
4223 } | |
4224 | |
4225 /* 6 */ | |
4226 void | |
4227 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4228 idx_vector& iv, idx_vector& jv) | |
4229 { | |
4230 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4231 | |
4232 for (int i = 0; i < iv.capacity (); i++) | |
4233 { | |
4234 int row = iv.elem (i); | |
4235 for (int j = 0; j < jv.capacity (); j++) | |
4236 { | |
4237 int col = jv.elem (j); | |
4238 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), | |
4239 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4240 } | |
4241 } | |
4242 } | |
4243 | |
4244 /* 7 */ | |
4245 void | |
4246 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4247 idx_vector& iv, Range& rj) | |
4248 { | |
4249 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4250 | |
4251 double b = rj.base (); | |
4252 double increment = rj.inc (); | |
4253 | |
4254 for (int i = 0; i < iv.capacity (); i++) | |
4255 { | |
4256 int row = iv.elem (i); | |
4257 for (int j = 0; j < rj.nelem (); j++) | |
4258 { | |
4259 double tmp = b + j * increment; | |
4260 int col = tree_to_mat_idx (tmp); | |
4261 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), | |
4262 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4263 } | |
4264 } | |
4265 } | |
4266 | |
4267 /* 8 */ | |
4268 void | |
4269 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, | |
4270 tree_constant_rep::constant_type mcj) | |
4271 { | |
4272 assert (mcj == magic_colon); | |
4273 | |
4274 if (rhs.is_zero_by_zero ()) | |
4275 { | |
4276 delete_rows (iv); | |
4277 } | |
4278 else | |
4279 { | |
4280 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4281 | |
4282 int nc = columns (); | |
4283 | |
4284 for (int j = 0; j < nc; j++) | |
4285 { | |
4286 for (int i = 0; i < iv.capacity (); i++) | |
4287 { | |
4288 int row = iv.elem (i); | |
4289 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), | |
4290 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4291 } | |
4292 } | |
4293 } | |
4294 } | |
4295 | |
4296 /* 9 */ | |
4297 void | |
4298 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, int j) | |
4299 { | |
4300 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4301 | |
4302 double b = ri.base (); | |
4303 double increment = ri.inc (); | |
4304 | |
4305 for (int i = 0; i < ri.nelem (); i++) | |
4306 { | |
4307 double tmp = b + i * increment; | |
4308 int row = tree_to_mat_idx (tmp); | |
4309 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, 0), | |
4310 rhs_cm.elem (i, 0), rhs.is_real_type ()); | |
4311 } | |
4312 } | |
4313 | |
4314 /* 10 */ | |
4315 void | |
4316 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, | |
4317 idx_vector& jv) | |
4318 { | |
4319 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4320 | |
4321 double b = ri.base (); | |
4322 double increment = ri.inc (); | |
4323 | |
4324 for (int j = 0; j < jv.capacity (); j++) | |
4325 { | |
4326 int col = jv.elem (j); | |
4327 for (int i = 0; i < ri.nelem (); i++) | |
4328 { | |
4329 double tmp = b + i * increment; | |
4330 int row = tree_to_mat_idx (tmp); | |
4331 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), | |
4332 rhs_m.elem (i, j), rhs.is_real_type ()); | |
4333 } | |
4334 } | |
4335 } | |
4336 | |
4337 /* 11 */ | |
4338 void | |
4339 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, | |
4340 Range& rj) | |
4341 { | |
4342 double ib = ri.base (); | |
4343 double iinc = ri.inc (); | |
4344 double jb = rj.base (); | |
4345 double jinc = rj.inc (); | |
4346 | |
4347 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4348 | |
4349 for (int i = 0; i < ri.nelem (); i++) | |
4350 { | |
4351 double itmp = ib + i * iinc; | |
4352 int row = tree_to_mat_idx (itmp); | |
4353 for (int j = 0; j < rj.nelem (); j++) | |
4354 { | |
4355 double jtmp = jb + j * jinc; | |
4356 int col = tree_to_mat_idx (jtmp); | |
4357 REP_ELEM_ASSIGN (row, col, rhs_m.elem (i, j), | |
4358 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4359 } | |
4360 } | |
4361 } | |
4362 | |
4363 /* 12 */ | |
4364 void | |
4365 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, | |
4366 tree_constant_rep::constant_type mcj) | |
4367 { | |
4368 assert (mcj == magic_colon); | |
4369 | |
4370 if (rhs.is_zero_by_zero ()) | |
4371 { | |
4372 delete_rows (ri); | |
4373 } | |
4374 else | |
4375 { | |
4376 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4377 | |
4378 double ib = ri.base (); | |
4379 double iinc = ri.inc (); | |
4380 | |
4381 int nc = columns (); | |
4382 | |
4383 for (int i = 0; i < ri.nelem (); i++) | |
4384 { | |
4385 double itmp = ib + i * iinc; | |
4386 int row = tree_to_mat_idx (itmp); | |
4387 for (int j = 0; j < nc; j++) | |
4388 REP_ELEM_ASSIGN (row, j, rhs_m.elem (i, j), | |
4389 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4390 } | |
4391 } | |
4392 } | |
4393 | |
4394 /* 13 */ | |
4395 void | |
4396 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4397 tree_constant_rep::constant_type mci, | |
4398 int j) | |
4399 { | |
4400 assert (mci == magic_colon); | |
4401 | |
4402 int nr = rows (); | |
4403 | |
4404 if (rhs.is_zero_by_zero ()) | |
4405 { | |
4406 delete_column (j); | |
4407 } | |
4408 else if (rhs.is_matrix_type ()) | |
4409 { | |
4410 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4411 | |
4412 for (int i = 0; i < nr; i++) | |
4413 REP_ELEM_ASSIGN (i, j, rhs_m.elem (i, 0), | |
4414 rhs_cm.elem (i, 0), rhs.is_real_type ()); | |
4415 } | |
4416 else if (rhs.is_scalar_type () && nr == 1) | |
4417 { | |
4418 REP_ELEM_ASSIGN (0, j, rhs.double_value (), | |
4419 rhs.complex_value (), rhs.is_real_type ()); | |
4420 } | |
4421 else | |
4422 panic_impossible (); | |
4423 } | |
4424 | |
4425 /* 14 */ | |
4426 void | |
4427 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4428 tree_constant_rep::constant_type mci, | |
4429 idx_vector& jv) | |
4430 { | |
4431 assert (mci == magic_colon); | |
4432 | |
4433 if (rhs.is_zero_by_zero ()) | |
4434 { | |
4435 delete_columns (jv); | |
4436 } | |
4437 else | |
4438 { | |
4439 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4440 | |
4441 int nr = rows (); | |
4442 | |
4443 for (int i = 0; i < nr; i++) | |
4444 { | |
4445 for (int j = 0; j < jv.capacity (); j++) | |
4446 { | |
4447 int col = jv.elem (j); | |
4448 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), | |
4449 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4450 } | |
4451 } | |
4452 } | |
4453 } | |
4454 | |
4455 /* 15 */ | |
4456 void | |
4457 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4458 tree_constant_rep::constant_type mci, | |
4459 Range& rj) | |
4460 { | |
4461 assert (mci == magic_colon); | |
4462 | |
4463 if (rhs.is_zero_by_zero ()) | |
4464 { | |
4465 delete_columns (rj); | |
4466 } | |
4467 else | |
4468 { | |
4469 REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); | |
4470 | |
4471 int nr = rows (); | |
4472 | |
4473 double jb = rj.base (); | |
4474 double jinc = rj.inc (); | |
4475 | |
4476 for (int j = 0; j < rj.nelem (); j++) | |
4477 { | |
4478 double jtmp = jb + j * jinc; | |
4479 int col = tree_to_mat_idx (jtmp); | |
4480 for (int i = 0; i < nr; i++) | |
4481 { | |
4482 REP_ELEM_ASSIGN (i, col, rhs_m.elem (i, j), | |
4483 rhs_cm.elem (i, j), rhs.is_real_type ()); | |
4484 } | |
4485 } | |
4486 } | |
4487 } | |
4488 | |
4489 /* 16 */ | |
4490 void | |
4491 tree_constant_rep::do_matrix_assignment (tree_constant& rhs, | |
4492 tree_constant_rep::constant_type mci, | |
4493 tree_constant_rep::constant_type mcj) | |
4494 { | |
4495 assert (mci == magic_colon && mcj == magic_colon); | |
4496 | |
4497 switch (type_tag) | |
4498 { | |
4499 case scalar_constant: | |
4500 break; | |
4501 case matrix_constant: | |
4502 delete matrix; | |
4503 break; | |
4504 case complex_scalar_constant: | |
4505 delete complex_scalar; | |
4506 break; | |
4507 case complex_matrix_constant: | |
4508 delete complex_matrix; | |
4509 break; | |
4510 case string_constant: | |
4511 delete [] string; | |
4512 break; | |
4513 case range_constant: | |
4514 delete range; | |
4515 break; | |
4516 case magic_colon: | |
4517 default: | |
4518 panic_impossible (); | |
4519 break; | |
4520 } | |
4521 | |
4522 type_tag = rhs.const_type (); | |
4523 | |
4524 switch (type_tag) | |
4525 { | |
4526 case scalar_constant: | |
4527 scalar = rhs.double_value (); | |
4528 break; | |
4529 case matrix_constant: | |
4530 matrix = new Matrix (rhs.matrix_value ()); | |
4531 break; | |
4532 case string_constant: | |
4533 string = strsave (rhs.string_value ()); | |
4534 break; | |
4535 case complex_matrix_constant: | |
4536 complex_matrix = new ComplexMatrix (rhs.complex_matrix_value ()); | |
4537 break; | |
4538 case complex_scalar_constant: | |
4539 complex_scalar = new Complex (rhs.complex_value ()); | |
4540 break; | |
4541 case range_constant: | |
4542 range = new Range (rhs.range_value ()); | |
4543 break; | |
4544 case magic_colon: | |
4545 default: | |
4546 panic_impossible (); | |
4547 break; | |
4548 } | |
4549 } | |
4550 | |
4551 /* | |
4552 * Functions for deleting rows or columns of a matrix. These are used | |
4553 * to handle statements like | |
4554 * | |
4555 * M (i, j) = [] | |
4556 */ | |
4557 void | |
4558 tree_constant_rep::delete_row (int idx) | |
4559 { | |
4560 if (type_tag == matrix_constant) | |
4561 { | |
4562 int nr = matrix->rows (); | |
4563 int nc = matrix->columns (); | |
4564 Matrix *new_matrix = new Matrix (nr-1, nc); | |
4565 int ii = 0; | |
4566 for (int i = 0; i < nr; i++) | |
4567 { | |
4568 if (i != idx) | |
4569 { | |
4570 for (int j = 0; j < nc; j++) | |
4571 new_matrix->elem (ii, j) = matrix->elem (i, j); | |
4572 ii++; | |
4573 } | |
4574 } | |
4575 delete matrix; | |
4576 matrix = new_matrix; | |
4577 } | |
4578 else if (type_tag == complex_matrix_constant) | |
4579 { | |
4580 int nr = complex_matrix->rows (); | |
4581 int nc = complex_matrix->columns (); | |
4582 ComplexMatrix *new_matrix = new ComplexMatrix (nr-1, nc); | |
4583 int ii = 0; | |
4584 for (int i = 0; i < nr; i++) | |
4585 { | |
4586 if (i != idx) | |
4587 { | |
4588 for (int j = 0; j < nc; j++) | |
4589 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); | |
4590 ii++; | |
4591 } | |
4592 } | |
4593 delete complex_matrix; | |
4594 complex_matrix = new_matrix; | |
4595 } | |
4596 else | |
4597 panic_impossible (); | |
4598 } | |
4599 | |
4600 void | |
4601 tree_constant_rep::delete_rows (idx_vector& iv) | |
4602 { | |
4603 iv.sort_uniq (); | |
4604 int num_to_delete = iv.length (); | |
4605 | |
4606 int nr = rows (); | |
4607 int nc = columns (); | |
4608 | |
4609 // If deleting all rows of a column vector, make result 0x0. | |
4610 if (nc == 1 && num_to_delete == nr) | |
4611 nc = 0; | |
4612 | |
4613 if (type_tag == matrix_constant) | |
4614 { | |
4615 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); | |
4616 if (nr > num_to_delete) | |
4617 { | |
4618 int ii = 0; | |
4619 int idx = 0; | |
4620 for (int i = 0; i < nr; i++) | |
4621 { | |
4622 if (i == iv.elem (idx)) | |
4623 idx++; | |
4624 else | |
4625 { | |
4626 for (int j = 0; j < nc; j++) | |
4627 new_matrix->elem (ii, j) = matrix->elem (i, j); | |
4628 ii++; | |
4629 } | |
4630 } | |
4631 } | |
4632 delete matrix; | |
4633 matrix = new_matrix; | |
4634 } | |
4635 else if (type_tag == complex_matrix_constant) | |
4636 { | |
4637 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); | |
4638 if (nr > num_to_delete) | |
4639 { | |
4640 int ii = 0; | |
4641 int idx = 0; | |
4642 for (int i = 0; i < nr; i++) | |
4643 { | |
4644 if (i == iv.elem (idx)) | |
4645 idx++; | |
4646 else | |
4647 { | |
4648 for (int j = 0; j < nc; j++) | |
4649 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); | |
4650 ii++; | |
4651 } | |
4652 } | |
4653 } | |
4654 delete complex_matrix; | |
4655 complex_matrix = new_matrix; | |
4656 } | |
4657 else | |
4658 panic_impossible (); | |
4659 } | |
4660 | |
4661 void | |
4662 tree_constant_rep::delete_rows (Range& ri) | |
4663 { | |
4664 ri.sort (); | |
4665 int num_to_delete = ri.nelem (); | |
4666 | |
4667 int nr = rows (); | |
4668 int nc = columns (); | |
4669 | |
4670 // If deleting all rows of a column vector, make result 0x0. | |
4671 if (nc == 1 && num_to_delete == nr) | |
4672 nc = 0; | |
4673 | |
4674 double ib = ri.base (); | |
4675 double iinc = ri.inc (); | |
4676 | |
4677 int max_idx = tree_to_mat_idx (ri.max ()); | |
4678 | |
4679 if (type_tag == matrix_constant) | |
4680 { | |
4681 Matrix *new_matrix = new Matrix (nr-num_to_delete, nc); | |
4682 if (nr > num_to_delete) | |
4683 { | |
4684 int ii = 0; | |
4685 int idx = 0; | |
4686 for (int i = 0; i < nr; i++) | |
4687 { | |
4688 double itmp = ib + idx * iinc; | |
4689 int row = tree_to_mat_idx (itmp); | |
4690 | |
4691 if (i == row && row <= max_idx) | |
4692 idx++; | |
4693 else | |
4694 { | |
4695 for (int j = 0; j < nc; j++) | |
4696 new_matrix->elem (ii, j) = matrix->elem (i, j); | |
4697 ii++; | |
4698 } | |
4699 } | |
4700 } | |
4701 delete matrix; | |
4702 matrix = new_matrix; | |
4703 } | |
4704 else if (type_tag == complex_matrix_constant) | |
4705 { | |
4706 ComplexMatrix *new_matrix = new ComplexMatrix (nr-num_to_delete, nc); | |
4707 if (nr > num_to_delete) | |
4708 { | |
4709 int ii = 0; | |
4710 int idx = 0; | |
4711 for (int i = 0; i < nr; i++) | |
4712 { | |
4713 double itmp = ib + idx * iinc; | |
4714 int row = tree_to_mat_idx (itmp); | |
4715 | |
4716 if (i == row && row <= max_idx) | |
4717 idx++; | |
4718 else | |
4719 { | |
4720 for (int j = 0; j < nc; j++) | |
4721 new_matrix->elem (ii, j) = complex_matrix->elem (i, j); | |
4722 ii++; | |
4723 } | |
4724 } | |
4725 } | |
4726 delete complex_matrix; | |
4727 complex_matrix = new_matrix; | |
4728 } | |
4729 else | |
4730 panic_impossible (); | |
4731 } | |
4732 | |
4733 void | |
4734 tree_constant_rep::delete_column (int idx) | |
4735 { | |
4736 if (type_tag == matrix_constant) | |
4737 { | |
4738 int nr = matrix->rows (); | |
4739 int nc = matrix->columns (); | |
4740 Matrix *new_matrix = new Matrix (nr, nc-1); | |
4741 int jj = 0; | |
4742 for (int j = 0; j < nc; j++) | |
4743 { | |
4744 if (j != idx) | |
4745 { | |
4746 for (int i = 0; i < nr; i++) | |
4747 new_matrix->elem (i, jj) = matrix->elem (i, j); | |
4748 jj++; | |
4749 } | |
4750 } | |
4751 delete matrix; | |
4752 matrix = new_matrix; | |
4753 } | |
4754 else if (type_tag == complex_matrix_constant) | |
4755 { | |
4756 int nr = complex_matrix->rows (); | |
4757 int nc = complex_matrix->columns (); | |
4758 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-1); | |
4759 int jj = 0; | |
4760 for (int j = 0; j < nc; j++) | |
4761 { | |
4762 if (j != idx) | |
4763 { | |
4764 for (int i = 0; i < nr; i++) | |
4765 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); | |
4766 jj++; | |
4767 } | |
4768 } | |
4769 delete complex_matrix; | |
4770 complex_matrix = new_matrix; | |
4771 } | |
4772 else | |
4773 panic_impossible (); | |
4774 } | |
4775 | |
4776 void | |
4777 tree_constant_rep::delete_columns (idx_vector& jv) | |
4778 { | |
4779 jv.sort_uniq (); | |
4780 int num_to_delete = jv.length (); | |
4781 | |
4782 int nr = rows (); | |
4783 int nc = columns (); | |
4784 | |
4785 // If deleting all columns of a row vector, make result 0x0. | |
4786 if (nr == 1 && num_to_delete == nc) | |
4787 nr = 0; | |
4788 | |
4789 if (type_tag == matrix_constant) | |
4790 { | |
4791 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); | |
4792 if (nc > num_to_delete) | |
4793 { | |
4794 int jj = 0; | |
4795 int idx = 0; | |
4796 for (int j = 0; j < nc; j++) | |
4797 { | |
4798 if (j == jv.elem (idx)) | |
4799 idx++; | |
4800 else | |
4801 { | |
4802 for (int i = 0; i < nr; i++) | |
4803 new_matrix->elem (i, jj) = matrix->elem (i, j); | |
4804 jj++; | |
4805 } | |
4806 } | |
4807 } | |
4808 delete matrix; | |
4809 matrix = new_matrix; | |
4810 } | |
4811 else if (type_tag == complex_matrix_constant) | |
4812 { | |
4813 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); | |
4814 if (nc > num_to_delete) | |
4815 { | |
4816 int jj = 0; | |
4817 int idx = 0; | |
4818 for (int j = 0; j < nc; j++) | |
4819 { | |
4820 if (j == jv.elem (idx)) | |
4821 idx++; | |
4822 else | |
4823 { | |
4824 for (int i = 0; i < nr; i++) | |
4825 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); | |
4826 jj++; | |
4827 } | |
4828 } | |
4829 } | |
4830 delete complex_matrix; | |
4831 complex_matrix = new_matrix; | |
4832 } | |
4833 else | |
4834 panic_impossible (); | |
4835 } | |
4836 | |
4837 void | |
4838 tree_constant_rep::delete_columns (Range& rj) | |
4839 { | |
4840 rj.sort (); | |
4841 int num_to_delete = rj.nelem (); | |
4842 | |
4843 int nr = rows (); | |
4844 int nc = columns (); | |
4845 | |
4846 // If deleting all columns of a row vector, make result 0x0. | |
4847 if (nr == 1 && num_to_delete == nc) | |
4848 nr = 0; | |
4849 | |
4850 double jb = rj.base (); | |
4851 double jinc = rj.inc (); | |
4852 | |
4853 int max_idx = tree_to_mat_idx (rj.max ()); | |
4854 | |
4855 if (type_tag == matrix_constant) | |
4856 { | |
4857 Matrix *new_matrix = new Matrix (nr, nc-num_to_delete); | |
4858 if (nc > num_to_delete) | |
4859 { | |
4860 int jj = 0; | |
4861 int idx = 0; | |
4862 for (int j = 0; j < nc; j++) | |
4863 { | |
4864 double jtmp = jb + idx * jinc; | |
4865 int col = tree_to_mat_idx (jtmp); | |
4866 | |
4867 if (j == col && col <= max_idx) | |
4868 idx++; | |
4869 else | |
4870 { | |
4871 for (int i = 0; i < nr; i++) | |
4872 new_matrix->elem (i, jj) = matrix->elem (i, j); | |
4873 jj++; | |
4874 } | |
4875 } | |
4876 } | |
4877 delete matrix; | |
4878 matrix = new_matrix; | |
4879 } | |
4880 else if (type_tag == complex_matrix_constant) | |
4881 { | |
4882 ComplexMatrix *new_matrix = new ComplexMatrix (nr, nc-num_to_delete); | |
4883 if (nc > num_to_delete) | |
4884 { | |
4885 int jj = 0; | |
4886 int idx = 0; | |
4887 for (int j = 0; j < nc; j++) | |
4888 { | |
4889 double jtmp = jb + idx * jinc; | |
4890 int col = tree_to_mat_idx (jtmp); | |
4891 | |
4892 if (j == col && col <= max_idx) | |
4893 idx++; | |
4894 else | |
4895 { | |
4896 for (int i = 0; i < nr; i++) | |
4897 new_matrix->elem (i, jj) = complex_matrix->elem (i, j); | |
4898 jj++; | |
4899 } | |
4900 } | |
4901 } | |
4902 delete complex_matrix; | |
4903 complex_matrix = new_matrix; | |
4904 } | |
4905 else | |
4906 panic_impossible (); | |
4907 } | |
4908 | |
4909 | |
4910 int | |
4911 tree_constant_rep::valid_as_scalar_index (void) const | |
4912 { | |
4913 int valid = type_tag == magic_colon | |
4914 || (type_tag == scalar_constant && NINT (scalar) == 1) | |
4915 || (type_tag == range_constant | |
4916 && range->nelem () == 1 && NINT (range->base ()) == 1); | |
4917 | |
4918 return valid; | |
4919 } | |
4920 | |
4921 tree_constant | |
4922 tree_constant_rep::do_scalar_index (const tree_constant *args, | |
4923 int nargs) const | |
4924 { | |
4925 if (valid_scalar_indices (args, nargs)) | |
4926 { | |
4927 if (type_tag == scalar_constant) | |
4928 return tree_constant (scalar); | |
4929 else if (type_tag == complex_scalar_constant) | |
4930 return tree_constant (*complex_scalar); | |
4931 else | |
4932 panic_impossible (); | |
4933 } | |
4934 else | |
4935 { | |
4936 int rows = 0; | |
4937 int cols = 0; | |
4938 | |
4939 switch (nargs) | |
4940 { | |
4941 case 3: | |
4942 { | |
4943 if (args[2].is_matrix_type ()) | |
4944 { | |
4945 Matrix mj = args[2].matrix_value (); | |
4946 | |
4947 idx_vector j (mj, user_pref.do_fortran_indexing, ""); | |
4948 if (! j) | |
4949 return tree_constant (); | |
4950 | |
4951 int len = j.length (); | |
4952 if (len == j.ones_count ()) | |
4953 cols = len; | |
4954 } | |
4955 else if (args[2].const_type () == magic_colon | |
4956 || (args[2].is_scalar_type () | |
4957 && NINT (args[2].double_value ()) == 1)) | |
4958 { | |
4959 cols = 1; | |
4960 } | |
4961 else | |
4962 break; | |
4963 } | |
4964 // Fall through... | |
4965 case 2: | |
4966 { | |
4967 if (args[1].is_matrix_type ()) | |
4968 { | |
4969 Matrix mi = args[1].matrix_value (); | |
4970 | |
4971 idx_vector i (mi, user_pref.do_fortran_indexing, ""); | |
4972 if (! i) | |
4973 return tree_constant (); | |
4974 | |
4975 int len = i.length (); | |
4976 if (len == i.ones_count ()) | |
4977 rows = len; | |
4978 } | |
4979 else if (args[1].const_type () == magic_colon | |
4980 || (args[1].is_scalar_type () | |
4981 && NINT (args[1].double_value ()) == 1)) | |
4982 { | |
4983 rows = 1; | |
4984 } | |
4985 else if (args[1].is_scalar_type () | |
4986 && NINT (args[1].double_value ()) == 0) | |
4987 { | |
4988 Matrix m (0, 0); | |
4989 return tree_constant (m); | |
4990 } | |
4991 else | |
4992 break; | |
4993 | |
4994 if (cols == 0) | |
4995 { | |
4996 if (user_pref.prefer_column_vectors) | |
4997 cols = 1; | |
4998 else | |
4999 { | |
5000 cols = rows; | |
5001 rows = 1; | |
5002 } | |
5003 } | |
5004 | |
5005 if (type_tag == scalar_constant) | |
5006 { | |
5007 Matrix m (rows, cols, scalar); | |
5008 return tree_constant (m); | |
5009 } | |
5010 else if (type_tag == complex_scalar_constant) | |
5011 { | |
5012 ComplexMatrix cm (rows, cols, *complex_scalar); | |
5013 return tree_constant (cm); | |
5014 } | |
5015 else | |
5016 panic_impossible (); | |
5017 } | |
5018 break; | |
5019 default: | |
5020 ::error ("illegal number of arguments for scalar type"); | |
5021 return tree_constant (); | |
5022 break; | |
5023 } | |
5024 } | |
5025 | |
5026 ::error ("index invalid or out of range for scalar type"); | |
5027 return tree_constant (); | |
5028 } | |
5029 | |
5030 tree_constant | |
5031 tree_constant_rep::do_matrix_index (const tree_constant *args, | |
5032 int nargin) const | |
5033 { | |
5034 tree_constant retval; | |
5035 | |
5036 switch (nargin) | |
5037 { | |
5038 case 2: | |
5039 if (args == NULL_TREE_CONST) | |
5040 ::error ("matrix index is null"); | |
5041 else if (args[1].is_undefined ()) | |
5042 ::error ("matrix index is a null expression"); | |
5043 else | |
5044 retval = do_matrix_index (args[1]); | |
5045 break; | |
5046 case 3: | |
5047 if (args == NULL_TREE_CONST) | |
5048 ::error ("matrix indices are null"); | |
5049 else if (args[1].is_undefined ()) | |
5050 ::error ("first matrix index is a null expression"); | |
5051 else if (args[2].is_undefined ()) | |
5052 ::error ("second matrix index is a null expression"); | |
5053 else | |
5054 retval = do_matrix_index (args[1], args[2]); | |
5055 break; | |
5056 default: | |
5057 ::error ("too many indices for matrix expression"); | |
5058 break; | |
5059 } | |
5060 | |
5061 return retval; | |
5062 } | |
5063 | |
5064 tree_constant | |
5065 tree_constant_rep::do_matrix_index (const tree_constant& i_arg) const | |
5066 { | |
5067 tree_constant retval; | |
5068 | |
5069 int nr = rows (); | |
5070 int nc = columns (); | |
5071 | |
5072 if (user_pref.do_fortran_indexing) | |
5073 retval = fortran_style_matrix_index (i_arg); | |
5074 else if (nr <= 1 || nc <= 1) | |
5075 retval = do_vector_index (i_arg); | |
5076 else | |
5077 ::error ("single index only valid for row or column vector"); | |
5078 | |
5079 return retval; | |
5080 } | |
5081 | |
5082 tree_constant | |
5083 tree_constant_rep::fortran_style_matrix_index | |
5084 (const tree_constant& i_arg) const | |
5085 { | |
5086 tree_constant retval; | |
5087 | |
5088 tree_constant tmp_i = i_arg.make_numeric_or_magic (); | |
5089 | |
5090 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
5091 | |
5092 int nr = rows (); | |
5093 int nc = columns (); | |
5094 | |
5095 switch (itype) | |
5096 { | |
5097 case complex_scalar_constant: | |
5098 case scalar_constant: | |
5099 { | |
5100 int i = NINT (tmp_i.double_value ()); | |
5101 int ii = fortran_row (i, nr) - 1; | |
5102 int jj = fortran_column (i, nr) - 1; | |
5103 if (index_check (i-1, "") < 0) | |
5104 return tree_constant (); | |
5105 if (range_max_check (i-1, nr * nc) < 0) | |
5106 return tree_constant (); | |
5107 retval = do_matrix_index (ii, jj); | |
5108 } | |
5109 break; | |
5110 case complex_matrix_constant: | |
5111 case matrix_constant: | |
5112 { | |
5113 Matrix mi = tmp_i.matrix_value (); | |
5114 if (mi.rows () == 0 || mi.columns () == 0) | |
5115 { | |
5116 Matrix mtmp; | |
5117 retval = tree_constant (mtmp); | |
5118 } | |
5119 else | |
5120 { | |
5121 // Yes, we really do want to call this with mi. | |
5122 retval = fortran_style_matrix_index (mi); | |
5123 } | |
5124 } | |
5125 break; | |
5126 case string_constant: | |
5127 gripe_string_invalid (); | |
5128 break; | |
5129 case range_constant: | |
5130 gripe_range_invalid (); | |
5131 break; | |
5132 case magic_colon: | |
5133 retval = do_matrix_index (magic_colon); | |
5134 break; | |
5135 default: | |
5136 panic_impossible (); | |
5137 break; | |
5138 } | |
5139 | |
5140 return retval; | |
5141 } | |
5142 | |
5143 tree_constant | |
5144 tree_constant_rep::fortran_style_matrix_index (const Matrix& mi) const | |
5145 { | |
5146 assert (is_matrix_type ()); | |
5147 | |
5148 tree_constant retval; | |
5149 | |
5150 int nr = rows (); | |
5151 int nc = columns (); | |
5152 | |
5153 int len = nr * nc; | |
5154 | |
5155 int index_nr = mi.rows (); | |
5156 int index_nc = mi.columns (); | |
5157 | |
5158 if (index_nr >= 1 && index_nc >= 1) | |
5159 { | |
5160 const double *cop_out = (const double *) NULL; | |
5161 const Complex *c_cop_out = (const Complex *) NULL; | |
5162 int real_type = type_tag == matrix_constant; | |
5163 if (real_type) | |
5164 cop_out = matrix->data (); | |
5165 else | |
5166 c_cop_out = complex_matrix->data (); | |
5167 | |
5168 const double *cop_out_index = mi.data (); | |
5169 | |
5170 idx_vector iv (mi, 1, "", len); | |
5171 if (! iv) | |
5172 return tree_constant (); | |
5173 | |
5174 int result_size = iv.length (); | |
5175 | |
5176 if (nc == 1 || (nr != 1 && iv.one_zero_only ())) | |
5177 { | |
5178 CRMATRIX (m, cm, result_size, 1); | |
5179 | |
5180 for (int i = 0; i < result_size; i++) | |
5181 { | |
5182 int idx = iv.elem (i); | |
5183 CRMATRIX_ASSIGN_ELEM (m, cm, i, 0, cop_out [idx], | |
5184 c_cop_out [idx], real_type); | |
5185 } | |
5186 | |
5187 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5188 } | |
5189 else if (nr == 1) | |
5190 { | |
5191 CRMATRIX (m, cm, 1, result_size); | |
5192 | |
5193 for (int i = 0; i < result_size; i++) | |
5194 { | |
5195 int idx = iv.elem (i); | |
5196 CRMATRIX_ASSIGN_ELEM (m, cm, 0, i, cop_out [idx], | |
5197 c_cop_out [idx], real_type); | |
5198 } | |
5199 | |
5200 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5201 } | |
5202 else | |
5203 { | |
5204 CRMATRIX (m, cm, index_nr, index_nc); | |
5205 | |
5206 for (int j = 0; j < index_nc; j++) | |
5207 for (int i = 0; i < index_nr; i++) | |
5208 { | |
5209 double tmp = *cop_out_index++; | |
5210 int idx = tree_to_mat_idx (tmp); | |
5211 CRMATRIX_ASSIGN_ELEM (m, cm, i, j, cop_out [idx], | |
5212 c_cop_out [idx], real_type); | |
5213 } | |
5214 | |
5215 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5216 } | |
5217 } | |
5218 else | |
5219 { | |
5220 if (index_nr == 0 || index_nc == 0) | |
5221 ::error ("empty matrix invalid as index"); | |
5222 else | |
5223 ::error ("invalid matrix index"); | |
5224 return tree_constant (); | |
5225 } | |
5226 | |
5227 return retval; | |
5228 } | |
5229 | |
5230 tree_constant | |
5231 tree_constant_rep::do_vector_index (const tree_constant& i_arg) const | |
5232 { | |
5233 tree_constant retval; | |
5234 | |
5235 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); | |
5236 | |
5237 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
5238 | |
5239 int nr = rows (); | |
5240 int nc = columns (); | |
5241 | |
5242 int len = nr > nc ? nr : nc; | |
5243 | |
5244 if (nr == 0 || nc == 0) | |
5245 { | |
5246 ::error ("attempt to index empty matrix"); | |
5247 return retval; | |
5248 } | |
5249 | |
5250 assert ((nr == 1 || nc == 1) && ! user_pref.do_fortran_indexing); | |
5251 | |
5252 int swap_indices = (nr == 1); | |
5253 | |
5254 switch (itype) | |
5255 { | |
5256 case complex_scalar_constant: | |
5257 case scalar_constant: | |
5258 { | |
5259 int i = tree_to_mat_idx (tmp_i.double_value ()); | |
5260 if (index_check (i, "") < 0) | |
5261 return tree_constant (); | |
5262 if (swap_indices) | |
5263 { | |
5264 if (range_max_check (i, nc) < 0) | |
5265 return tree_constant (); | |
5266 retval = do_matrix_index (0, i); | |
5267 } | |
5268 else | |
5269 { | |
5270 if (range_max_check (i, nr) < 0) | |
5271 return tree_constant (); | |
5272 retval = do_matrix_index (i, 0); | |
5273 } | |
5274 } | |
5275 break; | |
5276 case complex_matrix_constant: | |
5277 case matrix_constant: | |
5278 { | |
5279 Matrix mi = tmp_i.matrix_value (); | |
5280 if (mi.rows () == 0 || mi.columns () == 0) | |
5281 { | |
5282 Matrix mtmp; | |
5283 retval = tree_constant (mtmp); | |
5284 } | |
5285 else | |
5286 { | |
5287 idx_vector iv (mi, user_pref.do_fortran_indexing, "", len); | |
5288 if (! iv) | |
5289 return tree_constant (); | |
5290 | |
5291 if (swap_indices) | |
5292 { | |
5293 if (range_max_check (iv.max (), nc) < 0) | |
5294 return tree_constant (); | |
5295 retval = do_matrix_index (0, iv); | |
5296 } | |
5297 else | |
5298 { | |
5299 if (range_max_check (iv.max (), nr) < 0) | |
5300 return tree_constant (); | |
5301 retval = do_matrix_index (iv, 0); | |
5302 } | |
5303 } | |
5304 } | |
5305 break; | |
5306 case string_constant: | |
5307 gripe_string_invalid (); | |
5308 break; | |
5309 case range_constant: | |
5310 { | |
5311 Range ri = tmp_i.range_value (); | |
5312 if (len == 2 && is_zero_one (ri)) | |
5313 { | |
5314 if (swap_indices) | |
5315 retval = do_matrix_index (0, 1); | |
5316 else | |
5317 retval = do_matrix_index (1, 0); | |
5318 } | |
5319 else if (len == 2 && is_one_zero (ri)) | |
5320 { | |
5321 retval = do_matrix_index (0, 0); | |
5322 } | |
5323 else | |
5324 { | |
5325 if (index_check (ri, "") < 0) | |
5326 return tree_constant (); | |
5327 if (swap_indices) | |
5328 { | |
5329 if (range_max_check (tree_to_mat_idx (ri.max ()), nc) < 0) | |
5330 return tree_constant (); | |
5331 retval = do_matrix_index (0, ri); | |
5332 } | |
5333 else | |
5334 { | |
5335 if (range_max_check (tree_to_mat_idx (ri.max ()), nr) < 0) | |
5336 return tree_constant (); | |
5337 retval = do_matrix_index (ri, 0); | |
5338 } | |
5339 } | |
5340 } | |
5341 break; | |
5342 case magic_colon: | |
5343 if (swap_indices) | |
5344 retval = do_matrix_index (0, magic_colon); | |
5345 else | |
5346 retval = do_matrix_index (magic_colon, 0); | |
5347 break; | |
5348 default: | |
5349 panic_impossible (); | |
5350 break; | |
5351 } | |
5352 | |
5353 return retval; | |
5354 } | |
5355 | |
5356 tree_constant | |
5357 tree_constant_rep::do_matrix_index (const tree_constant& i_arg, | |
5358 const tree_constant& j_arg) const | |
5359 { | |
5360 tree_constant retval; | |
5361 | |
5362 tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); | |
5363 | |
5364 tree_constant_rep::constant_type itype = tmp_i.const_type (); | |
5365 | |
5366 switch (itype) | |
5367 { | |
5368 case complex_scalar_constant: | |
5369 case scalar_constant: | |
5370 { | |
5371 int i = tree_to_mat_idx (tmp_i.double_value ()); | |
5372 if (index_check (i, "row") < 0) | |
5373 return tree_constant (); | |
5374 retval = do_matrix_index (i, j_arg); | |
5375 } | |
5376 break; | |
5377 case complex_matrix_constant: | |
5378 case matrix_constant: | |
5379 { | |
5380 Matrix mi = tmp_i.matrix_value (); | |
5381 idx_vector iv (mi, user_pref.do_fortran_indexing, "row", rows ()); | |
5382 if (! iv) | |
5383 return tree_constant (); | |
5384 | |
5385 if (iv.length () == 0) | |
5386 { | |
5387 Matrix mtmp; | |
5388 retval = tree_constant (mtmp); | |
5389 } | |
5390 else | |
5391 retval = do_matrix_index (iv, j_arg); | |
5392 } | |
5393 break; | |
5394 case string_constant: | |
5395 gripe_string_invalid (); | |
5396 break; | |
5397 case range_constant: | |
5398 { | |
5399 Range ri = tmp_i.range_value (); | |
5400 int nr = rows (); | |
5401 if (nr == 2 && is_zero_one (ri)) | |
5402 { | |
5403 retval = do_matrix_index (1, j_arg); | |
5404 } | |
5405 else if (nr == 2 && is_one_zero (ri)) | |
5406 { | |
5407 retval = do_matrix_index (0, j_arg); | |
5408 } | |
5409 else | |
5410 { | |
5411 if (index_check (ri, "row") < 0) | |
5412 return tree_constant (); | |
5413 retval = do_matrix_index (ri, j_arg); | |
5414 } | |
5415 } | |
5416 break; | |
5417 case magic_colon: | |
5418 retval = do_matrix_index (magic_colon, j_arg); | |
5419 break; | |
5420 default: | |
5421 panic_impossible (); | |
5422 break; | |
5423 } | |
5424 | |
5425 return retval; | |
5426 } | |
5427 | |
5428 tree_constant | |
5429 tree_constant_rep::do_matrix_index (int i, const tree_constant& j_arg) const | |
5430 { | |
5431 tree_constant retval; | |
5432 | |
5433 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
5434 | |
5435 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
5436 | |
5437 int nr = rows (); | |
5438 int nc = columns (); | |
5439 | |
5440 switch (jtype) | |
5441 { | |
5442 case complex_scalar_constant: | |
5443 case scalar_constant: | |
5444 { | |
5445 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
5446 if (index_check (j, "column") < 0) | |
5447 return tree_constant (); | |
5448 if (range_max_check (i, j, nr, nc) < 0) | |
5449 return tree_constant (); | |
5450 retval = do_matrix_index (i, j); | |
5451 } | |
5452 break; | |
5453 case complex_matrix_constant: | |
5454 case matrix_constant: | |
5455 { | |
5456 Matrix mj = tmp_j.matrix_value (); | |
5457 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); | |
5458 if (! jv) | |
5459 return tree_constant (); | |
5460 | |
5461 if (jv.length () == 0) | |
5462 { | |
5463 Matrix mtmp; | |
5464 retval = tree_constant (mtmp); | |
5465 } | |
5466 else | |
5467 { | |
5468 if (range_max_check (i, jv.max (), nr, nc) < 0) | |
5469 return tree_constant (); | |
5470 retval = do_matrix_index (i, jv); | |
5471 } | |
5472 } | |
5473 break; | |
5474 case string_constant: | |
5475 gripe_string_invalid (); | |
5476 break; | |
5477 case range_constant: | |
5478 { | |
5479 Range rj = tmp_j.range_value (); | |
5480 if (nc == 2 && is_zero_one (rj)) | |
5481 { | |
5482 retval = do_matrix_index (i, 1); | |
5483 } | |
5484 else if (nc == 2 && is_one_zero (rj)) | |
5485 { | |
5486 retval = do_matrix_index (i, 0); | |
5487 } | |
5488 else | |
5489 { | |
5490 if (index_check (rj, "column") < 0) | |
5491 return tree_constant (); | |
5492 if (range_max_check (i, tree_to_mat_idx (rj.max ()), nr, nc) < 0) | |
5493 return tree_constant (); | |
5494 retval = do_matrix_index (i, rj); | |
5495 } | |
5496 } | |
5497 break; | |
5498 case magic_colon: | |
5499 if (range_max_check (i, 0, nr, nc) < 0) | |
5500 return tree_constant (); | |
5501 retval = do_matrix_index (i, magic_colon); | |
5502 break; | |
5503 default: | |
5504 panic_impossible (); | |
5505 break; | |
5506 } | |
5507 | |
5508 return retval; | |
5509 } | |
5510 | |
5511 tree_constant | |
5512 tree_constant_rep::do_matrix_index (const idx_vector& iv, | |
5513 const tree_constant& j_arg) const | |
5514 { | |
5515 tree_constant retval; | |
5516 | |
5517 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
5518 | |
5519 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
5520 | |
5521 int nr = rows (); | |
5522 int nc = columns (); | |
5523 | |
5524 switch (jtype) | |
5525 { | |
5526 case complex_scalar_constant: | |
5527 case scalar_constant: | |
5528 { | |
5529 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
5530 if (index_check (j, "column") < 0) | |
5531 return tree_constant (); | |
5532 if (range_max_check (iv.max (), j, nr, nc) < 0) | |
5533 return tree_constant (); | |
5534 retval = do_matrix_index (iv, j); | |
5535 } | |
5536 break; | |
5537 case complex_matrix_constant: | |
5538 case matrix_constant: | |
5539 { | |
5540 Matrix mj = tmp_j.matrix_value (); | |
5541 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); | |
5542 if (! jv) | |
5543 return tree_constant (); | |
5544 | |
5545 if (jv.length () == 0) | |
5546 { | |
5547 Matrix mtmp; | |
5548 retval = tree_constant (mtmp); | |
5549 } | |
5550 else | |
5551 { | |
5552 if (range_max_check (iv.max (), jv.max (), nr, nc) < 0) | |
5553 return tree_constant (); | |
5554 retval = do_matrix_index (iv, jv); | |
5555 } | |
5556 } | |
5557 break; | |
5558 case string_constant: | |
5559 gripe_string_invalid (); | |
5560 break; | |
5561 case range_constant: | |
5562 { | |
5563 Range rj = tmp_j.range_value (); | |
5564 if (nc == 2 && is_zero_one (rj)) | |
5565 { | |
5566 retval = do_matrix_index (iv, 1); | |
5567 } | |
5568 else if (nc == 2 && is_one_zero (rj)) | |
5569 { | |
5570 retval = do_matrix_index (iv, 0); | |
5571 } | |
5572 else | |
5573 { | |
5574 if (index_check (rj, "column") < 0) | |
5575 return tree_constant (); | |
5576 if (range_max_check (iv.max (), tree_to_mat_idx (rj.max ()), | |
5577 nr, nc) < 0) | |
5578 return tree_constant (); | |
5579 retval = do_matrix_index (iv, rj); | |
5580 } | |
5581 } | |
5582 break; | |
5583 case magic_colon: | |
5584 if (range_max_check (iv.max (), 0, nr, nc) < 0) | |
5585 return tree_constant (); | |
5586 retval = do_matrix_index (iv, magic_colon); | |
5587 break; | |
5588 default: | |
5589 panic_impossible (); | |
5590 break; | |
5591 } | |
5592 | |
5593 return retval; | |
5594 } | |
5595 | |
5596 tree_constant | |
5597 tree_constant_rep::do_matrix_index (const Range& ri, | |
5598 const tree_constant& j_arg) const | |
5599 { | |
5600 tree_constant retval; | |
5601 | |
5602 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
5603 | |
5604 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
5605 | |
5606 int nr = rows (); | |
5607 int nc = columns (); | |
5608 | |
5609 switch (jtype) | |
5610 { | |
5611 case complex_scalar_constant: | |
5612 case scalar_constant: | |
5613 { | |
5614 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
5615 if (index_check (j, "column") < 0) | |
5616 return tree_constant (); | |
5617 if (range_max_check (tree_to_mat_idx (ri.max ()), j, nr, nc) < 0) | |
5618 return tree_constant (); | |
5619 retval = do_matrix_index (ri, j); | |
5620 } | |
5621 break; | |
5622 case complex_matrix_constant: | |
5623 case matrix_constant: | |
5624 { | |
5625 Matrix mj = tmp_j.matrix_value (); | |
5626 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); | |
5627 if (! jv) | |
5628 return tree_constant (); | |
5629 | |
5630 if (jv.length () == 0) | |
5631 { | |
5632 Matrix mtmp; | |
5633 retval = tree_constant (mtmp); | |
5634 } | |
5635 else | |
5636 { | |
5637 if (range_max_check (tree_to_mat_idx (ri.max ()), | |
5638 jv.max (), nr, nc) < 0) | |
5639 return tree_constant (); | |
5640 retval = do_matrix_index (ri, jv); | |
5641 } | |
5642 } | |
5643 break; | |
5644 case string_constant: | |
5645 gripe_string_invalid (); | |
5646 break; | |
5647 case range_constant: | |
5648 { | |
5649 Range rj = tmp_j.range_value (); | |
5650 if (nc == 2 && is_zero_one (rj)) | |
5651 { | |
5652 retval = do_matrix_index (ri, 1); | |
5653 } | |
5654 else if (nc == 2 && is_one_zero (rj)) | |
5655 { | |
5656 retval = do_matrix_index (ri, 0); | |
5657 } | |
5658 else | |
5659 { | |
5660 if (index_check (rj, "column") < 0) | |
5661 return tree_constant (); | |
5662 if (range_max_check (tree_to_mat_idx (ri.max ()), | |
5663 tree_to_mat_idx (rj.max ()), nr, nc) < 0) | |
5664 return tree_constant (); | |
5665 retval = do_matrix_index (ri, rj); | |
5666 } | |
5667 } | |
5668 break; | |
5669 case magic_colon: | |
5670 retval = do_matrix_index (ri, magic_colon); | |
5671 break; | |
5672 default: | |
5673 panic_impossible (); | |
5674 break; | |
5675 } | |
5676 | |
5677 return retval; | |
5678 } | |
5679 | |
5680 tree_constant | |
5681 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, | |
5682 const tree_constant& j_arg) const | |
5683 { | |
5684 tree_constant retval; | |
5685 | |
5686 tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); | |
5687 | |
5688 tree_constant_rep::constant_type jtype = tmp_j.const_type (); | |
5689 | |
5690 int nr = rows (); | |
5691 int nc = columns (); | |
5692 | |
5693 switch (jtype) | |
5694 { | |
5695 case complex_scalar_constant: | |
5696 case scalar_constant: | |
5697 { | |
5698 int j = tree_to_mat_idx (tmp_j.double_value ()); | |
5699 if (index_check (j, "column") < 0) | |
5700 return tree_constant (); | |
5701 if (range_max_check (0, j, nr, nc) < 0) | |
5702 return tree_constant (); | |
5703 retval = do_matrix_index (magic_colon, j); | |
5704 } | |
5705 break; | |
5706 case complex_matrix_constant: | |
5707 case matrix_constant: | |
5708 { | |
5709 Matrix mj = tmp_j.matrix_value (); | |
5710 idx_vector jv (mj, user_pref.do_fortran_indexing, "column", nc); | |
5711 if (! jv) | |
5712 return tree_constant (); | |
5713 | |
5714 if (jv.length () == 0) | |
5715 { | |
5716 Matrix mtmp; | |
5717 retval = tree_constant (mtmp); | |
5718 } | |
5719 else | |
5720 { | |
5721 if (range_max_check (0, jv.max (), nr, nc) < 0) | |
5722 return tree_constant (); | |
5723 retval = do_matrix_index (magic_colon, jv); | |
5724 } | |
5725 } | |
5726 break; | |
5727 case string_constant: | |
5728 gripe_string_invalid (); | |
5729 break; | |
5730 case range_constant: | |
5731 { | |
5732 Range rj = tmp_j.range_value (); | |
5733 if (nc == 2 && is_zero_one (rj)) | |
5734 { | |
5735 retval = do_matrix_index (magic_colon, 1); | |
5736 } | |
5737 else if (nc == 2 && is_one_zero (rj)) | |
5738 { | |
5739 retval = do_matrix_index (magic_colon, 0); | |
5740 } | |
5741 else | |
5742 { | |
5743 if (index_check (rj, "column") < 0) | |
5744 return tree_constant (); | |
5745 if (range_max_check (0, tree_to_mat_idx (rj.max ()), nr, nc) < 0) | |
5746 return tree_constant (); | |
5747 retval = do_matrix_index (magic_colon, rj); | |
5748 } | |
5749 } | |
5750 break; | |
5751 case magic_colon: | |
5752 retval = do_matrix_index (magic_colon, magic_colon); | |
5753 break; | |
5754 default: | |
5755 panic_impossible (); | |
5756 break; | |
5757 } | |
5758 | |
5759 return retval; | |
5760 } | |
5761 | |
5762 tree_constant | |
5763 tree_constant_rep::do_matrix_index (int i, int j) const | |
5764 { | |
5765 tree_constant retval; | |
5766 | |
5767 if (type_tag == matrix_constant) | |
5768 retval = tree_constant (matrix->elem (i, j)); | |
5769 else | |
5770 retval = tree_constant (complex_matrix->elem (i, j)); | |
5771 | |
5772 return retval; | |
5773 } | |
5774 | |
5775 tree_constant | |
5776 tree_constant_rep::do_matrix_index (int i, const idx_vector& jv) const | |
5777 { | |
5778 tree_constant retval; | |
5779 | |
5780 int jlen = jv.capacity (); | |
5781 | |
5782 CRMATRIX (m, cm, 1, jlen); | |
5783 | |
5784 for (int j = 0; j < jlen; j++) | |
5785 { | |
5786 int col = jv.elem (j); | |
5787 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); | |
5788 } | |
5789 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5790 | |
5791 return retval; | |
5792 } | |
5793 | |
5794 tree_constant | |
5795 tree_constant_rep::do_matrix_index (int i, const Range& rj) const | |
5796 { | |
5797 tree_constant retval; | |
5798 | |
5799 int jlen = rj.nelem (); | |
5800 | |
5801 CRMATRIX (m, cm, 1, jlen); | |
5802 | |
5803 double b = rj.base (); | |
5804 double increment = rj.inc (); | |
5805 for (int j = 0; j < jlen; j++) | |
5806 { | |
5807 double tmp = b + j * increment; | |
5808 int col = tree_to_mat_idx (tmp); | |
5809 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, col); | |
5810 } | |
5811 | |
5812 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5813 | |
5814 return retval; | |
5815 } | |
5816 | |
5817 tree_constant | |
5818 tree_constant_rep::do_matrix_index | |
5819 (int i, tree_constant_rep::constant_type mcj) const | |
5820 { | |
5821 assert (mcj == magic_colon); | |
5822 | |
5823 tree_constant retval; | |
5824 | |
5825 int nc = columns (); | |
5826 | |
5827 CRMATRIX (m, cm, 1, nc); | |
5828 | |
5829 for (int j = 0; j < nc; j++) | |
5830 { | |
5831 CRMATRIX_ASSIGN_REP_ELEM (m, cm, 0, j, i, j); | |
5832 } | |
5833 | |
5834 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5835 | |
5836 return retval; | |
5837 } | |
5838 | |
5839 tree_constant | |
5840 tree_constant_rep::do_matrix_index (const idx_vector& iv, int j) const | |
5841 { | |
5842 tree_constant retval; | |
5843 | |
5844 int ilen = iv.capacity (); | |
5845 | |
5846 CRMATRIX (m, cm, ilen, 1); | |
5847 | |
5848 for (int i = 0; i < ilen; i++) | |
5849 { | |
5850 int row = iv.elem (i); | |
5851 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); | |
5852 } | |
5853 | |
5854 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5855 | |
5856 return retval; | |
5857 } | |
5858 | |
5859 tree_constant | |
5860 tree_constant_rep::do_matrix_index (const idx_vector& iv, | |
5861 const idx_vector& jv) const | |
5862 { | |
5863 tree_constant retval; | |
5864 | |
5865 int ilen = iv.capacity (); | |
5866 int jlen = jv.capacity (); | |
5867 | |
5868 CRMATRIX (m, cm, ilen, jlen); | |
5869 | |
5870 for (int i = 0; i < ilen; i++) | |
5871 { | |
5872 int row = iv.elem (i); | |
5873 for (int j = 0; j < jlen; j++) | |
5874 { | |
5875 int col = jv.elem (j); | |
5876 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); | |
5877 } | |
5878 } | |
5879 | |
5880 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5881 | |
5882 return retval; | |
5883 } | |
5884 | |
5885 tree_constant | |
5886 tree_constant_rep::do_matrix_index (const idx_vector& iv, | |
5887 const Range& rj) const | |
5888 { | |
5889 tree_constant retval; | |
5890 | |
5891 int ilen = iv.capacity (); | |
5892 int jlen = rj.nelem (); | |
5893 | |
5894 CRMATRIX (m, cm, ilen, jlen); | |
5895 | |
5896 double b = rj.base (); | |
5897 double increment = rj.inc (); | |
5898 | |
5899 for (int i = 0; i < ilen; i++) | |
5900 { | |
5901 int row = iv.elem (i); | |
5902 for (int j = 0; j < jlen; j++) | |
5903 { | |
5904 double tmp = b + j * increment; | |
5905 int col = tree_to_mat_idx (tmp); | |
5906 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); | |
5907 } | |
5908 } | |
5909 | |
5910 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5911 | |
5912 return retval; | |
5913 } | |
5914 | |
5915 tree_constant | |
5916 tree_constant_rep::do_matrix_index | |
5917 (const idx_vector& iv, tree_constant_rep::constant_type mcj) const | |
5918 { | |
5919 assert (mcj == magic_colon); | |
5920 | |
5921 tree_constant retval; | |
5922 | |
5923 int nc = columns (); | |
5924 int ilen = iv.capacity (); | |
5925 | |
5926 CRMATRIX (m, cm, ilen, nc); | |
5927 | |
5928 for (int j = 0; j < nc; j++) | |
5929 { | |
5930 for (int i = 0; i < ilen; i++) | |
5931 { | |
5932 int row = iv.elem (i); | |
5933 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); | |
5934 } | |
5935 } | |
5936 | |
5937 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5938 | |
5939 return retval; | |
5940 } | |
5941 | |
5942 tree_constant | |
5943 tree_constant_rep::do_matrix_index (const Range& ri, int j) const | |
5944 { | |
5945 tree_constant retval; | |
5946 | |
5947 int ilen = ri.nelem (); | |
5948 | |
5949 CRMATRIX (m, cm, ilen, 1); | |
5950 | |
5951 double b = ri.base (); | |
5952 double increment = ri.inc (); | |
5953 for (int i = 0; i < ilen; i++) | |
5954 { | |
5955 double tmp = b + i * increment; | |
5956 int row = tree_to_mat_idx (tmp); | |
5957 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, row, j); | |
5958 } | |
5959 | |
5960 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5961 | |
5962 return retval; | |
5963 } | |
5964 | |
5965 tree_constant | |
5966 tree_constant_rep::do_matrix_index (const Range& ri, | |
5967 const idx_vector& jv) const | |
5968 { | |
5969 tree_constant retval; | |
5970 | |
5971 int ilen = ri.nelem (); | |
5972 int jlen = jv.capacity (); | |
5973 | |
5974 CRMATRIX (m, cm, ilen, jlen); | |
5975 | |
5976 double b = ri.base (); | |
5977 double increment = ri.inc (); | |
5978 for (int i = 0; i < ilen; i++) | |
5979 { | |
5980 double tmp = b + i * increment; | |
5981 int row = tree_to_mat_idx (tmp); | |
5982 for (int j = 0; j < jlen; j++) | |
5983 { | |
5984 int col = jv.elem (j); | |
5985 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); | |
5986 } | |
5987 } | |
5988 | |
5989 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
5990 | |
5991 return retval; | |
5992 } | |
5993 | |
5994 tree_constant | |
5995 tree_constant_rep::do_matrix_index (const Range& ri, const Range& rj) const | |
5996 { | |
5997 tree_constant retval; | |
5998 | |
5999 int ilen = ri.nelem (); | |
6000 int jlen = rj.nelem (); | |
6001 | |
6002 CRMATRIX (m, cm, ilen, jlen); | |
6003 | |
6004 double ib = ri.base (); | |
6005 double iinc = ri.inc (); | |
6006 double jb = rj.base (); | |
6007 double jinc = rj.inc (); | |
6008 | |
6009 for (int i = 0; i < ilen; i++) | |
6010 { | |
6011 double itmp = ib + i * iinc; | |
6012 int row = tree_to_mat_idx (itmp); | |
6013 for (int j = 0; j < jlen; j++) | |
6014 { | |
6015 double jtmp = jb + j * jinc; | |
6016 int col = tree_to_mat_idx (jtmp); | |
6017 | |
6018 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, col); | |
6019 } | |
6020 } | |
6021 | |
6022 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6023 | |
6024 return retval; | |
6025 } | |
6026 | |
6027 tree_constant | |
6028 tree_constant_rep::do_matrix_index | |
6029 (const Range& ri, tree_constant_rep::constant_type mcj) const | |
6030 { | |
6031 assert (mcj == magic_colon); | |
6032 | |
6033 tree_constant retval; | |
6034 | |
6035 int nc = columns (); | |
6036 | |
6037 int ilen = ri.nelem (); | |
6038 | |
6039 CRMATRIX (m, cm, ilen, nc); | |
6040 | |
6041 double ib = ri.base (); | |
6042 double iinc = ri.inc (); | |
6043 | |
6044 for (int i = 0; i < ilen; i++) | |
6045 { | |
6046 double itmp = ib + i * iinc; | |
6047 int row = tree_to_mat_idx (itmp); | |
6048 for (int j = 0; j < nc; j++) | |
6049 { | |
6050 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, row, j); | |
6051 } | |
6052 } | |
6053 | |
6054 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6055 | |
6056 return retval; | |
6057 } | |
6058 | |
6059 tree_constant | |
6060 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, | |
6061 int j) const | |
6062 { | |
6063 assert (mci == magic_colon); | |
6064 | |
6065 tree_constant retval; | |
6066 | |
6067 int nr = rows (); | |
6068 | |
6069 CRMATRIX (m, cm, nr, 1); | |
6070 | |
6071 for (int i = 0; i < nr; i++) | |
6072 { | |
6073 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, 0, i, j); | |
6074 } | |
6075 | |
6076 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6077 | |
6078 return retval; | |
6079 } | |
6080 | |
6081 tree_constant | |
6082 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, | |
6083 const idx_vector& jv) const | |
6084 { | |
6085 assert (mci == magic_colon); | |
6086 | |
6087 tree_constant retval; | |
6088 | |
6089 int nr = rows (); | |
6090 int jlen = jv.capacity (); | |
6091 | |
6092 CRMATRIX (m, cm, nr, jlen); | |
6093 | |
6094 for (int i = 0; i < nr; i++) | |
6095 { | |
6096 for (int j = 0; j < jlen; j++) | |
6097 { | |
6098 int col = jv.elem (j); | |
6099 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); | |
6100 } | |
6101 } | |
6102 | |
6103 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6104 | |
6105 return retval; | |
6106 } | |
6107 | |
6108 tree_constant | |
6109 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, | |
6110 const Range& rj) const | |
6111 { | |
6112 assert (mci == magic_colon); | |
6113 | |
6114 tree_constant retval; | |
6115 | |
6116 int nr = rows (); | |
6117 int jlen = rj.nelem (); | |
6118 | |
6119 CRMATRIX (m, cm, nr, jlen); | |
6120 | |
6121 double jb = rj.base (); | |
6122 double jinc = rj.inc (); | |
6123 | |
6124 for (int j = 0; j < jlen; j++) | |
6125 { | |
6126 double jtmp = jb + j * jinc; | |
6127 int col = tree_to_mat_idx (jtmp); | |
6128 for (int i = 0; i < nr; i++) | |
6129 { | |
6130 CRMATRIX_ASSIGN_REP_ELEM (m, cm, i, j, i, col); | |
6131 } | |
6132 } | |
6133 | |
6134 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6135 | |
6136 return retval; | |
6137 } | |
6138 | |
6139 tree_constant | |
6140 tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, | |
6141 tree_constant_rep::constant_type mcj) const | |
6142 { | |
6143 assert (mci == magic_colon && mcj == magic_colon); | |
6144 | |
6145 return tree_constant (*this); | |
6146 } | |
6147 | |
6148 tree_constant | |
6149 tree_constant_rep::do_matrix_index | |
6150 (tree_constant_rep::constant_type mci) const | |
6151 { | |
6152 assert (mci == magic_colon); | |
6153 | |
6154 tree_constant retval; | |
6155 int nr = rows (); | |
6156 int nc = columns (); | |
6157 int size = nr * nc; | |
6158 if (size > 0) | |
6159 { | |
6160 CRMATRIX (m, cm, size, 1); | |
6161 int idx = 0; | |
6162 for (int j = 0; j < nc; j++) | |
6163 for (int i = 0; i < nr; i++) | |
6164 { | |
6165 CRMATRIX_ASSIGN_REP_ELEM (m, cm, idx, 0, i, j); | |
6166 idx++; | |
6167 } | |
6168 ASSIGN_CRMATRIX_TO (retval, m, cm); | |
6169 } | |
6170 return retval; | |
6171 } | |
6172 | |
2655 /* | 6173 /* |
2656 ;;; Local Variables: *** | 6174 ;;; Local Variables: *** |
2657 ;;; mode: C++ *** | 6175 ;;; mode: C++ *** |
2658 ;;; page-delimiter: "^/\\*" *** | 6176 ;;; page-delimiter: "^/\\*" *** |
2659 ;;; End: *** | 6177 ;;; End: *** |