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: ***