Mercurial > octave

comparison src/pt-const.cc @ 1:78fd87e624cb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1993-08-08 01:13:40 by jwe] Initial revision
author jwe
date Sun, 08 Aug 1993 01:13:40 +0000
parents
children 36ff440553cd
comparison
equal deleted inserted replaced
0:22412e3a4641 1:78fd87e624cb
1 // The constants for the tree class. -*- C++ -*-
2 /*
3
4 Copyright (C) 1992, 1993 John W. Eaton
5
6 This file is part of Octave.
7
8 Octave is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 Octave is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with Octave; see the file COPYING. If not, write to the Free
20 Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
21
22 */
23
24 #ifdef __GNUG__
25 #pragma implementation
26 #endif
27
28 #include <ctype.h>
29 #include <string.h>
30 #include <iostream.h>
31 #include <strstream.h>
32 #include <math.h>
33
34 #include "variables.h"
35 #include "error.h"
36 #include "gripes.h"
37 #include "user-prefs.h"
38 #include "utils.h"
39 #include "pager.h"
40 #include "mappers.h"
41 #include "pr-output.h"
42 #include "tree-const.h"
43 #include "arith-ops.h"
44
45 // A couple of handy helper functions.
46
47 static int
48 any_element_is_negative (const Matrix& a)
49 {
50 int nr = a.rows ();
51 int nc = a.columns ();
52 for (int j = 0; j < nc; j++)
53 for (int i = 0; i < nr; i++)
54 if (a.elem (i, j) < 0.0)
55 return 1;
56 return 0;
57 }
58
59 static int
60 any_element_is_complex (const ComplexMatrix& a)
61 {
62 int nr = a.rows ();
63 int nc = a.columns ();
64 for (int j = 0; j < nc; j++)
65 for (int i = 0; i < nr; i++)
66 if (imag (a.elem (i, j)) != 0.0)
67 return 1;
68 return 0;
69 }
70
71 // Now, the classes.
72
73 /*
74 * The real representation of constants.
75 */
76 tree_constant_rep::tree_constant_rep (void)
77 {
78 type_tag = unknown_constant;
79 }
80
81 tree_constant_rep::tree_constant_rep (double d)
82 {
83 scalar = d;
84 type_tag = scalar_constant;
85 }
86
87 tree_constant_rep::tree_constant_rep (Matrix& m)
88 {
89 if (m.rows () == 1 && m.columns () == 1)
90 {
91 scalar = m.elem (0, 0);
92 type_tag = scalar_constant;
93 }
94 else
95 {
96 matrix = new Matrix (m);
97 type_tag = matrix_constant;
98 }
99 }
100
101 tree_constant_rep::tree_constant_rep (DiagMatrix& d)
102 {
103 if (d.rows () == 1 && d.columns () == 1)
104 {
105 scalar = d.elem (0, 0);
106 type_tag = scalar_constant;
107 }
108 else
109 {
110 matrix = new Matrix (d);
111 type_tag = matrix_constant;
112 }
113 }
114
115 tree_constant_rep::tree_constant_rep (RowVector& v)
116 {
117 int len = v.capacity ();
118 if (len == 1)
119 {
120 scalar = v.elem (0);
121 type_tag = scalar_constant;
122 }
123 else
124 {
125 if (user_pref.prefer_column_vectors)
126 {
127 Matrix m (len, 1);
128 for (int i = 0; i < len; i++)
129 m.elem (i, 0) = v.elem (i);
130 matrix = new Matrix (m);
131 type_tag = matrix_constant;
132 }
133 else
134 {
135 Matrix m (1, len);
136 for (int i = 0; i < len; i++)
137 m.elem (0, i) = v.elem (i);
138 matrix = new Matrix (m);
139 type_tag = matrix_constant;
140 }
141 }
142 }
143
144 tree_constant_rep::tree_constant_rep (RowVector& v, int prefer_column_vector)
145 {
146 int len = v.capacity ();
147 if (len == 1)
148 {
149 scalar = v.elem (0);
150 type_tag = scalar_constant;
151 }
152 else
153 {
154 if (prefer_column_vector)
155 {
156 Matrix m (len, 1);
157 for (int i = 0; i < len; i++)
158 m.elem (i, 0) = v.elem (i);
159 matrix = new Matrix (m);
160 type_tag = matrix_constant;
161 }
162 else
163 {
164 Matrix m (1, len);
165 for (int i = 0; i < len; i++)
166 m.elem (0, i) = v.elem (i);
167 matrix = new Matrix (m);
168 type_tag = matrix_constant;
169 }
170 }
171 }
172
173 tree_constant_rep::tree_constant_rep (ColumnVector& v)
174 {
175 int len = v.capacity ();
176 if (len == 1)
177 {
178 scalar = v.elem (0);
179 type_tag = scalar_constant;
180 }
181 else
182 {
183 if (user_pref.prefer_column_vectors)
184 {
185 Matrix m (len, 1);
186 for (int i = 0; i < len; i++)
187 m.elem (i, 0) = v.elem (i);
188 matrix = new Matrix (m);
189 type_tag = matrix_constant;
190 }
191 else
192 {
193 Matrix m (1, len);
194 for (int i = 0; i < len; i++)
195 m.elem (0, i) = v.elem (i);
196 matrix = new Matrix (m);
197 type_tag = matrix_constant;
198 }
199 }
200 }
201
202 tree_constant_rep::tree_constant_rep (ColumnVector& v,
203 int prefer_column_vector)
204 {
205 int len = v.capacity ();
206 if (len == 1)
207 {
208 scalar = v.elem (0);
209 type_tag = scalar_constant;
210 }
211 else
212 {
213 if (prefer_column_vector)
214 {
215 Matrix m (len, 1);
216 for (int i = 0; i < len; i++)
217 m.elem (i, 0) = v.elem (i);
218 matrix = new Matrix (m);
219 type_tag = matrix_constant;
220 }
221 else
222 {
223 Matrix m (1, len);
224 for (int i = 0; i < len; i++)
225 m.elem (0, i) = v.elem (i);
226 matrix = new Matrix (m);
227 type_tag = matrix_constant;
228 }
229 }
230 }
231
232 tree_constant_rep::tree_constant_rep (Complex c)
233 {
234 complex_scalar = new Complex (c);
235 type_tag = complex_scalar_constant;
236 }
237
238 tree_constant_rep::tree_constant_rep (ComplexRowVector& v)
239 {
240 int len = v.capacity ();
241 if (len == 1)
242 {
243 complex_scalar = new Complex (v.elem (0));
244 type_tag = complex_scalar_constant;
245 }
246 else
247 {
248 if (user_pref.prefer_column_vectors)
249 {
250 ComplexMatrix m (len, 1);
251 for (int i = 0; i < len; i++)
252 m.elem (i, 0) = v.elem (i);
253 complex_matrix = new ComplexMatrix (m);
254 type_tag = complex_matrix_constant;
255 }
256 else
257 {
258 ComplexMatrix m (1, len);
259 for (int i = 0; i < len; i++)
260 m.elem (0, i) = v.elem (i);
261 complex_matrix = new ComplexMatrix (m);
262 type_tag = complex_matrix_constant;
263 }
264 }
265 }
266
267 tree_constant_rep::tree_constant_rep (ComplexMatrix& m)
268 {
269 if (m.rows () == 1 && m.columns () == 1)
270 {
271 complex_scalar = new Complex (m.elem (0, 0));
272 type_tag = complex_scalar_constant;
273 }
274 else
275 {
276 complex_matrix = new ComplexMatrix (m);
277 type_tag = complex_matrix_constant;
278 }
279 }
280
281 tree_constant_rep::tree_constant_rep (ComplexDiagMatrix& d)
282 {
283 if (d.rows () == 1 && d.columns () == 1)
284 {
285 complex_scalar = new Complex (d.elem (0, 0));
286 type_tag = complex_scalar_constant;
287 }
288 else
289 {
290 complex_matrix = new ComplexMatrix (d);
291 type_tag = complex_matrix_constant;
292 }
293 }
294
295 tree_constant_rep::tree_constant_rep (ComplexRowVector& v,
296 int prefer_column_vector)
297 {
298 int len = v.capacity ();
299 if (len == 1)
300 {
301 complex_scalar = new Complex (v.elem (0));
302 type_tag = complex_scalar_constant;
303 }
304 else
305 {
306 if (prefer_column_vector)
307 {
308 ComplexMatrix m (len, 1);
309 for (int i = 0; i < len; i++)
310 m.elem (i, 0) = v.elem (i);
311 complex_matrix = new ComplexMatrix (m);
312 type_tag = complex_matrix_constant;
313 }
314 else
315 {
316 ComplexMatrix m (1, len);
317 for (int i = 0; i < len; i++)
318 m.elem (0, i) = v.elem (i);
319 complex_matrix = new ComplexMatrix (m);
320 type_tag = complex_matrix_constant;
321 }
322 }
323 }
324
325 tree_constant_rep::tree_constant_rep (ComplexColumnVector& v)
326 {
327 int len = v.capacity ();
328 if (len == 1)
329 {
330 complex_scalar = new Complex (v.elem (0));
331 type_tag = complex_scalar_constant;
332 }
333 else
334 {
335 if (user_pref.prefer_column_vectors)
336 {
337 ComplexMatrix m (len, 1);
338 for (int i = 0; i < len; i++)
339 m.elem (i, 0) = v.elem (i);
340 complex_matrix = new ComplexMatrix (m);
341 type_tag = complex_matrix_constant;
342 }
343 else
344 {
345 ComplexMatrix m (1, len);
346 for (int i = 0; i < len; i++)
347 m.elem (0, i) = v.elem (i);
348 complex_matrix = new ComplexMatrix (m);
349 type_tag = complex_matrix_constant;
350 }
351 }
352 }
353
354 tree_constant_rep::tree_constant_rep (ComplexColumnVector& v,
355 int prefer_column_vector)
356 {
357 int len = v.capacity ();
358 if (len == 1)
359 {
360 complex_scalar = new Complex (v.elem (0));
361 type_tag = complex_scalar_constant;
362 }
363 else
364 {
365 if (prefer_column_vector)
366 {
367 ComplexMatrix m (len, 1);
368 for (int i = 0; i < len; i++)
369 m.elem (i, 0) = v.elem (i);
370 complex_matrix = new ComplexMatrix (m);
371 type_tag = complex_matrix_constant;
372 }
373 else
374 {
375 ComplexMatrix m (1, len);
376 for (int i = 0; i < len; i++)
377 m.elem (0, i) = v.elem (i);
378 complex_matrix = new ComplexMatrix (m);
379 type_tag = complex_matrix_constant;
380 }
381 }
382 }
383
384 tree_constant_rep::tree_constant_rep (const char *s)
385 {
386 string = strsave (s);
387 type_tag = string_constant;
388 }
389
390 tree_constant_rep::tree_constant_rep (String& s)
391 {
392 string = strsave (s);
393 type_tag = string_constant;
394 }
395
396 tree_constant_rep::tree_constant_rep (double b, double l, double i)
397 {
398 range = new Range (b, l, i);
399 int nel = range->nelem ();
400 if (nel < 0)
401 {
402 if (nel == -1)
403 error ("number of elements in range exceeds INT_MAX");
404 else
405 error ("invalid range");
406
407 jump_to_top_level ();
408 }
409 else if (nel > 1)
410 type_tag = range_constant;
411 else
412 {
413 delete range;
414 if (nel == 1)
415 {
416 scalar = b;
417 type_tag = scalar_constant;
418 }
419 else if (nel == 0)
420 {
421 matrix = new Matrix ();
422 type_tag = matrix_constant;
423 }
424 else
425 panic_impossible ();
426 }
427 }
428
429 tree_constant_rep::tree_constant_rep (Range& r)
430 {
431 if (r.nelem () > 1)
432 {
433 range = new Range (r);
434 type_tag = range_constant;
435 }
436 else if (r.nelem () == 1)
437 {
438 scalar = r.base ();
439 type_tag = scalar_constant;
440 }
441 else if (r.nelem () == 0)
442 {
443 matrix = new Matrix ();
444 type_tag = matrix_constant;
445 }
446 else
447 panic_impossible ();
448 }
449
450 tree_constant_rep::tree_constant_rep (tree_constant_rep::constant_type t)
451 {
452 assert (t == magic_colon);
453
454 type_tag = magic_colon;
455 }
456
457 tree_constant_rep::tree_constant_rep (tree_constant_rep& t)
458 {
459 type_tag = t.type_tag;
460
461 switch (t.type_tag)
462 {
463 case unknown_constant:
464 break;
465 case scalar_constant:
466 scalar = t.scalar;
467 break;
468 case matrix_constant:
469 matrix = new Matrix (*(t.matrix));
470 break;
471 case string_constant:
472 string = strsave (t.string);
473 break;
474 case complex_matrix_constant:
475 complex_matrix = new ComplexMatrix (*(t.complex_matrix));
476 break;
477 case complex_scalar_constant:
478 complex_scalar = new Complex (*(t.complex_scalar));
479 break;
480 case range_constant:
481 range = new Range (*(t.range));
482 break;
483 case magic_colon:
484 break;
485 default:
486 panic_impossible ();
487 break;
488 }
489 }
490
491 tree_constant_rep::~tree_constant_rep (void)
492 {
493 switch (type_tag)
494 {
495 case unknown_constant:
496 break;
497 case scalar_constant:
498 break;
499 case matrix_constant:
500 delete matrix;
501 break;
502 case complex_scalar_constant:
503 delete complex_scalar;
504 break;
505 case complex_matrix_constant:
506 delete complex_matrix;
507 break;
508 case string_constant:
509 delete [] string;
510 break;
511 case range_constant:
512 delete range;
513 break;
514 case magic_colon:
515 break;
516 default:
517 panic_impossible ();
518 break;
519 }
520 }
521
522 #if defined (MDEBUG)
523 void *
524 tree_constant_rep::operator new (size_t size)
525 {
526 tree_constant_rep *p = ::new tree_constant_rep;
527 cerr << "tree_constant_rep::new(): " << p << "\n";
528 return p;
529 }
530
531 void
532 tree_constant_rep::operator delete (void *p, size_t size)
533 {
534 cerr << "tree_constant_rep::delete(): " << p << "\n";
535 ::delete p;
536 }
537 #endif
538
539 void
540 tree_constant_rep::resize (int i, int j)
541 {
542 switch (type_tag)
543 {
544 case matrix_constant:
545 matrix->resize (i, j);
546 break;
547 case complex_matrix_constant:
548 complex_matrix->resize (i, j);
549 break;
550 default:
551 panic_impossible ();
552 break;
553 }
554 }
555
556 void
557 tree_constant_rep::resize (int i, int j, double val)
558 {
559 switch (type_tag)
560 {
561 case matrix_constant:
562 matrix->resize (i, j, val);
563 break;
564 case complex_matrix_constant:
565 complex_matrix->resize (i, j, val);
566 break;
567 default:
568 panic_impossible ();
569 break;
570 }
571 }
572
573 void
574 tree_constant_rep::maybe_resize (int i, int j)
575 {
576 int nr = rows ();
577 int nc = columns ();
578
579 i++;
580 j++;
581
582 assert (i > 0 && j > 0);
583
584 if (i > nr || j > nc)
585 {
586 if (user_pref.resize_on_range_error)
587 resize (MAX (i, nr), MAX (j, nc), 0.0);
588 else
589 {
590 if (i > nr)
591 message ((char *) NULL,
592 "row index = %d exceeds max row dimension = %d", i, nr);
593 if (j > nc)
594 message ((char *) NULL,
595 "column index = %d exceeds max column dimension = %d",
596 j, nc);
597
598 jump_to_top_level ();
599 }
600 }
601 }
602
603 void
604 tree_constant_rep::maybe_resize (int i, force_orient f_orient = no_orient)
605 {
606 int nr = rows ();
607 int nc = columns ();
608
609 i++;
610
611 assert (i > 0 && (nr <= 1 || nc <= 1));
612
613 if (nr <= 1 && nc <= 1 && i >= 1)
614 {
615 if (user_pref.resize_on_range_error)
616 {
617 if (f_orient == row_orient)
618 resize (1, i, 0.0);
619 else if (f_orient == column_orient)
620 resize (i, 1, 0.0);
621 else if (user_pref.prefer_column_vectors)
622 resize (i, 1, 0.0);
623 else
624 resize (1, i, 0.0);
625 }
626 else
627 {
628 message ((char *) NULL,
629 "matrix index = %d exceeds max dimension = %d", i, nc);
630 jump_to_top_level ();
631 }
632 }
633 else if (nr == 1 && i > nc)
634 {
635 if (user_pref.resize_on_range_error)
636 resize (1, i, 0.0);
637 else
638 {
639 message ((char *) NULL,
640 "matrix index = %d exceeds max dimension = %d", i, nc);
641 jump_to_top_level ();
642 }
643 }
644 else if (nc == 1 && i > nr)
645 {
646 if (user_pref.resize_on_range_error)
647 resize (i, 1, 0.0);
648 else
649 {
650 message ((char *) NULL,
651 "matrix index = %d exceeds max dimension = ", i, nc);
652 jump_to_top_level ();
653 }
654 }
655 }
656
657 double
658 tree_constant_rep::to_scalar (void)
659 {
660 tree_constant tmp = make_numeric ();
661
662 double retval = 0.0;
663
664 switch (tmp.const_type ())
665 {
666 case tree_constant_rep::scalar_constant:
667 case tree_constant_rep::complex_scalar_constant:
668 retval = tmp.double_value ();
669 break;
670 case tree_constant_rep::matrix_constant:
671 if (user_pref.do_fortran_indexing)
672 {
673 Matrix m = tmp.matrix_value ();
674 retval = m (0, 0);
675 }
676 break;
677 case tree_constant_rep::complex_matrix_constant:
678 if (user_pref.do_fortran_indexing)
679 {
680 int flag = user_pref.ok_to_lose_imaginary_part;
681 if (flag == -1)
682 warning ("implicit conversion of complex value to real value");
683
684 if (flag != 0)
685 {
686 ComplexMatrix m = tmp.complex_matrix_value ();
687 return real (m (0, 0));
688 }
689 else
690 jump_to_top_level ();
691 }
692 else
693 {
694 error ("complex matrix used in invalid context");
695 jump_to_top_level ();
696 }
697 break;
698 default:
699 break;
700 }
701 return retval;
702 }
703
704 ColumnVector
705 tree_constant_rep::to_vector (void)
706 {
707 tree_constant tmp = make_numeric ();
708
709 ColumnVector retval;
710
711 switch (tmp.const_type ())
712 {
713 case tree_constant_rep::scalar_constant:
714 case tree_constant_rep::complex_scalar_constant:
715 retval.resize (1);
716 retval.elem (0) = tmp.double_value ();
717 break;
718 case tree_constant_rep::complex_matrix_constant:
719 case tree_constant_rep::matrix_constant:
720 {
721 Matrix m = tmp.matrix_value ();
722 int nr = m.rows ();
723 int nc = m.columns ();
724 if (nr == 1)
725 {
726 retval.resize (nc);
727 for (int i = 0; i < nc; i++)
728 retval.elem (i) = m (0, i);
729 }
730 else if (nc == 1)
731 {
732 retval.resize (nr);
733 for (int i = 0; i < nr; i++)
734 retval.elem (i) = m.elem (i, 0);
735 }
736 }
737 break;
738 default:
739 panic_impossible ();
740 break;
741 }
742 return retval;
743 }
744
745 Matrix
746 tree_constant_rep::to_matrix (void)
747 {
748 tree_constant tmp = make_numeric ();
749
750 Matrix retval;
751
752 switch (tmp.const_type ())
753 {
754 case tree_constant_rep::scalar_constant:
755 retval.resize (1, 1);
756 retval.elem (0, 0) = tmp.double_value ();
757 break;
758 case tree_constant_rep::matrix_constant:
759 retval = tmp.matrix_value ();
760 break;
761 default:
762 break;
763 }
764 return retval;
765 }
766
767 tree_constant_rep::constant_type
768 tree_constant_rep::force_numeric (int force_str_conv = 0)
769 {
770 switch (type_tag)
771 {
772 case scalar_constant:
773 case matrix_constant:
774 case complex_scalar_constant:
775 case complex_matrix_constant:
776 break;
777 case string_constant:
778 {
779 if (! force_str_conv && ! user_pref.implicit_str_to_num_ok)
780 {
781 error ("failed to convert `%s' to a numeric type -- default\
782 conversion turned off", string);
783 // Abort!
784 jump_to_top_level ();
785 }
786
787 int len = strlen (string);
788 if (len > 1)
789 {
790 type_tag = matrix_constant;
791 Matrix *tm = new Matrix (1, len);
792 for (int i = 0; i < len; i++)
793 tm->elem (0, i) = toascii ((int) string[i]);
794 matrix = tm;
795 }
796 else if (len == 1)
797 {
798 type_tag = scalar_constant;
799 scalar = toascii ((int) string[0]);
800 }
801 }
802 break;
803 case range_constant:
804 {
805 int len = range->nelem ();
806 if (len > 1)
807 {
808 type_tag = matrix_constant;
809 Matrix *tm = new Matrix (1, len);
810 double b = range->base ();
811 double increment = range->inc ();
812 for (int i = 0; i < len; i++)
813 tm->elem (0, i) = b + i * increment;
814 matrix = tm;
815 }
816 else if (len == 1)
817 {
818 type_tag = scalar_constant;
819 scalar = range->base ();
820 }
821 }
822 break;
823 case magic_colon:
824 default:
825 panic_impossible ();
826 break;
827 }
828 return type_tag;
829 }
830
831 tree_constant
832 tree_constant_rep::make_numeric (int force_str_conv = 0)
833 {
834 tree_constant retval;
835 switch (type_tag)
836 {
837 case scalar_constant:
838 retval = tree_constant (scalar);
839 break;
840 case matrix_constant:
841 retval = tree_constant (*matrix);
842 break;
843 case complex_scalar_constant:
844 retval = tree_constant (*complex_scalar);
845 break;
846 case complex_matrix_constant:
847 retval = tree_constant (*complex_matrix);
848 break;
849 case string_constant:
850 retval = tree_constant (string);
851 retval.force_numeric (force_str_conv);
852 break;
853 case range_constant:
854 retval = tree_constant (*range);
855 retval.force_numeric (force_str_conv);
856 break;
857 case magic_colon:
858 default:
859 panic_impossible ();
860 break;
861 }
862 return retval;
863 }
864
865 tree_constant
866 do_binary_op (tree_constant& a, tree_constant& b, tree::expression_type t)
867 {
868 int first_empty = (a.rows () == 0 || a.columns () == 0);
869 int second_empty = (b.rows () == 0 || b.columns () == 0);
870
871 if (first_empty || second_empty)
872 {
873 int flag = user_pref.propagate_empty_matrices;
874 if (flag < 0)
875 warning ("binary operation on empty matrix");
876 else if (flag == 0)
877 {
878 error ("invalid binary operation on empty matrix");
879 jump_to_top_level ();
880 }
881 }
882
883 tree_constant tmp_a = a.make_numeric ();
884 tree_constant tmp_b = b.make_numeric ();
885
886 tree_constant_rep::constant_type a_type = tmp_a.const_type ();
887 tree_constant_rep::constant_type b_type = tmp_b.const_type ();
888
889 double d1, d2;
890 Matrix m1, m2;
891 Complex c1, c2;
892 ComplexMatrix cm1, cm2;
893
894 tree_constant ans;
895
896 switch (a_type)
897 {
898 case tree_constant_rep::scalar_constant:
899 d1 = tmp_a.double_value ();
900 switch (b_type)
901 {
902 case tree_constant_rep::scalar_constant:
903 d2 = tmp_b.double_value ();
904 ans = do_binary_op (d1, d2, t);
905 break;
906 case tree_constant_rep::matrix_constant:
907 m2 = tmp_b.matrix_value ();
908 ans = do_binary_op (d1, m2, t);
909 break;
910 case tree_constant_rep::complex_scalar_constant:
911 c2 = tmp_b.complex_value ();
912 ans = do_binary_op (d1, c2, t);
913 break;
914 case tree_constant_rep::complex_matrix_constant:
915 cm2 = tmp_b.complex_matrix_value ();
916 ans = do_binary_op (d1, cm2, t);
917 break;
918 case tree_constant_rep::magic_colon:
919 default:
920 panic_impossible ();
921 break;
922 }
923 break;
924 case tree_constant_rep::matrix_constant:
925 m1 = tmp_a.matrix_value ();
926 switch (b_type)
927 {
928 case tree_constant_rep::scalar_constant:
929 d2 = tmp_b.double_value ();
930 ans = do_binary_op (m1, d2, t);
931 break;
932 case tree_constant_rep::matrix_constant:
933 m2 = tmp_b.matrix_value ();
934 ans = do_binary_op (m1, m2, t);
935 break;
936 case tree_constant_rep::complex_scalar_constant:
937 c2 = tmp_b.complex_value ();
938 ans = do_binary_op (m1, c2, t);
939 break;
940 case tree_constant_rep::complex_matrix_constant:
941 cm2 = tmp_b.complex_matrix_value ();
942 ans = do_binary_op (m1, cm2, t);
943 break;
944 case tree_constant_rep::magic_colon:
945 default:
946 panic_impossible ();
947 break;
948 }
949 break;
950 case tree_constant_rep::complex_scalar_constant:
951 c1 = tmp_a.complex_value ();
952 switch (b_type)
953 {
954 case tree_constant_rep::scalar_constant:
955 d2 = tmp_b.double_value ();
956 ans = do_binary_op (c1, d2, t);
957 break;
958 case tree_constant_rep::matrix_constant:
959 m2 = tmp_b.matrix_value ();
960 ans = do_binary_op (c1, m2, t);
961 break;
962 case tree_constant_rep::complex_scalar_constant:
963 c2 = tmp_b.complex_value ();
964 ans = do_binary_op (c1, c2, t);
965 break;
966 case tree_constant_rep::complex_matrix_constant:
967 cm2 = tmp_b.complex_matrix_value ();
968 ans = do_binary_op (c1, cm2, t);
969 break;
970 case tree_constant_rep::magic_colon:
971 default:
972 panic_impossible ();
973 break;
974 }
975 break;
976 case tree_constant_rep::complex_matrix_constant:
977 cm1 = tmp_a.complex_matrix_value ();
978 switch (b_type)
979 {
980 case tree_constant_rep::scalar_constant:
981 d2 = tmp_b.double_value ();
982 ans = do_binary_op (cm1, d2, t);
983 break;
984 case tree_constant_rep::matrix_constant:
985 m2 = tmp_b.matrix_value ();
986 ans = do_binary_op (cm1, m2, t);
987 break;
988 case tree_constant_rep::complex_scalar_constant:
989 c2 = tmp_b.complex_value ();
990 ans = do_binary_op (cm1, c2, t);
991 break;
992 case tree_constant_rep::complex_matrix_constant:
993 cm2 = tmp_b.complex_matrix_value ();
994 ans = do_binary_op (cm1, cm2, t);
995 break;
996 case tree_constant_rep::magic_colon:
997 default:
998 panic_impossible ();
999 break;
1000 }
1001 break;
1002 case tree_constant_rep::magic_colon:
1003 default:
1004 panic_impossible ();
1005 break;
1006 }
1007 return ans;
1008 }
1009
1010 tree_constant
1011 do_unary_op (tree_constant& a, tree::expression_type t)
1012 {
1013 if (a.rows () == 0 || a.columns () == 0)
1014 {
1015 int flag = user_pref.propagate_empty_matrices;
1016 if (flag < 0)
1017 warning ("unary operation on empty matrix");
1018 else if (flag == 0)
1019 {
1020 error ("invalid unary operation on empty matrix");
1021 jump_to_top_level ();
1022 }
1023 }
1024
1025 tree_constant tmp_a = a.make_numeric ();
1026
1027 tree_constant ans;
1028
1029 switch (tmp_a.const_type ())
1030 {
1031 case tree_constant_rep::scalar_constant:
1032 ans = do_unary_op (tmp_a.double_value (), t);
1033 break;
1034 case tree_constant_rep::matrix_constant:
1035 {
1036 Matrix m = tmp_a.matrix_value ();
1037 ans = do_unary_op (m, t);
1038 }
1039 break;
1040 case tree_constant_rep::complex_scalar_constant:
1041 ans = do_unary_op (tmp_a.complex_value (), t);
1042 break;
1043 case tree_constant_rep::complex_matrix_constant:
1044 {
1045 ComplexMatrix m = tmp_a.complex_matrix_value ();
1046 ans = do_unary_op (m, t);
1047 }
1048 break;
1049 case tree_constant_rep::magic_colon:
1050 default:
1051 panic_impossible ();
1052 break;
1053 }
1054 return ans;
1055 }
1056
1057 void
1058 tree_constant_rep::bump_value (tree::expression_type etype)
1059 {
1060 switch (etype)
1061 {
1062 case tree::increment:
1063 switch (type_tag)
1064 {
1065 case scalar_constant:
1066 scalar++;
1067 break;
1068 case matrix_constant:
1069 *matrix = *matrix + 1.0;
1070 break;
1071 case complex_scalar_constant:
1072 *complex_scalar = *complex_scalar + 1.0;
1073 break;
1074 case complex_matrix_constant:
1075 *complex_matrix = *complex_matrix + 1.0;
1076 break;
1077 case string_constant:
1078 error ("string++ and ++string not implemented yet, ok?");
1079 break;
1080 case range_constant:
1081 range->set_base (range->base () + 1.0);
1082 range->set_limit (range->limit () + 1.0);
1083 break;
1084 case magic_colon:
1085 default:
1086 panic_impossible ();
1087 break;
1088 }
1089 break;
1090 case tree::decrement:
1091 switch (type_tag)
1092 {
1093 case scalar_constant:
1094 scalar--;
1095 break;
1096 case matrix_constant:
1097 *matrix = *matrix - 1.0;
1098 break;
1099 case string_constant:
1100 error ("string-- and -- string not implemented yet, ok?");
1101 break;
1102 case range_constant:
1103 range->set_base (range->base () - 1.0);
1104 range->set_limit (range->limit () - 1.0);
1105 break;
1106 case magic_colon:
1107 default:
1108 panic_impossible ();
1109 break;
1110 }
1111 break;
1112 default:
1113 panic_impossible ();
1114 break;
1115 }
1116 }
1117
1118 void
1119 tree_constant_rep::eval (int print)
1120 {
1121 switch (type_tag)
1122 {
1123 case complex_scalar_constant:
1124 if (imag (*complex_scalar) == 0.0)
1125 {
1126 double d = real (*complex_scalar);
1127 delete complex_scalar;
1128 scalar = d;
1129 type_tag = scalar_constant;
1130 }
1131 break;
1132 case complex_matrix_constant:
1133 if (! any_element_is_complex (*complex_matrix))
1134 {
1135 Matrix *m = new Matrix (real (*complex_matrix));
1136 delete complex_matrix;
1137 matrix = m;
1138 type_tag = matrix_constant;
1139 }
1140 break;
1141 case scalar_constant:
1142 case matrix_constant:
1143 case string_constant:
1144 case range_constant:
1145 case magic_colon:
1146 break;
1147 default:
1148 panic_impossible ();
1149 break;
1150 }
1151
1152 if (print)
1153 {
1154 int nr = rows ();
1155 int nc = columns ();
1156
1157 ostrstream output_buf;
1158 switch (type_tag)
1159 {
1160 case scalar_constant:
1161 octave_print_internal (output_buf, scalar);
1162 break;
1163 case matrix_constant:
1164 if (nr == 0 || nc == 0)
1165 {
1166 output_buf << "[]";
1167 if (user_pref.print_empty_dimensions)
1168 output_buf << "(" << nr << "x" << nc << ")";
1169 output_buf << "\n";
1170 }
1171 else
1172 octave_print_internal (output_buf, *matrix);
1173 break;
1174 case complex_scalar_constant:
1175 octave_print_internal (output_buf, *complex_scalar);
1176 break;
1177 case complex_matrix_constant:
1178 if (nr == 0 || nc == 0)
1179 {
1180 output_buf << "[]";
1181 if (user_pref.print_empty_dimensions)
1182 output_buf << "(" << nr << "x" << nc << ")";
1183 output_buf << "\n";
1184 }
1185 else
1186 octave_print_internal (output_buf, *complex_matrix);
1187 break;
1188 case string_constant:
1189 output_buf << string << "\n";
1190 break;
1191 case range_constant:
1192 octave_print_internal (output_buf, *range);
1193 break;
1194 case magic_colon:
1195 default:
1196 panic_impossible ();
1197 break;
1198 }
1199
1200 output_buf << ends;
1201 maybe_page_output (output_buf);
1202 }
1203 }
1204
1205 tree_constant *
1206 tree_constant_rep::eval (tree_constant *args, int nargin, int nargout,
1207 int print)
1208 {
1209 tree_constant *retval = new tree_constant [2];
1210 switch (type_tag)
1211 {
1212 case complex_scalar_constant:
1213 case scalar_constant:
1214 retval[0] = do_scalar_index (args, nargin);
1215 break;
1216 case complex_matrix_constant:
1217 case matrix_constant:
1218 retval[0] = do_matrix_index (args, nargin);
1219 break;
1220 case string_constant:
1221 gripe_string_invalid ();
1222 // retval[0] = do_string_index (args, nargin);
1223 break;
1224 case magic_colon:
1225 case range_constant:
1226 // This isn\'t great, but it\'s easier than implementing a lot of
1227 // range indexing functions.
1228 force_numeric ();
1229 assert (type_tag != magic_colon && type_tag != range_constant);
1230 return eval (args, nargin, nargout, print);
1231 break;
1232 default:
1233 panic_impossible ();
1234 break;
1235 }
1236
1237 if (retval[0].is_defined ())
1238 retval[0].eval (print);
1239 return retval;
1240 }
1241
1242 int
1243 tree_constant_rep::save (ostream& os, int mark_as_global)
1244 {
1245 switch (type_tag)
1246 {
1247 case scalar_constant:
1248 case matrix_constant:
1249 case complex_scalar_constant:
1250 case complex_matrix_constant:
1251 case string_constant:
1252 case range_constant:
1253 if (mark_as_global)
1254 os << "# type: global ";
1255 else
1256 os << "# type: ";
1257 break;
1258 case magic_colon:
1259 default:
1260 break;
1261 }
1262
1263 switch (type_tag)
1264 {
1265 case scalar_constant:
1266 os << "scalar\n"
1267 << scalar << "\n";
1268 break;
1269 case matrix_constant:
1270 os << "matrix\n"
1271 << "# rows: " << rows () << "\n"
1272 << "# columns: " << columns () << "\n"
1273 << *matrix ;
1274 break;
1275 case complex_scalar_constant:
1276 os << "complex scalar\n"
1277 << *complex_scalar << "\n";
1278 break;
1279 case complex_matrix_constant:
1280 os << "complex matrix\n"
1281 << "# rows: " << rows () << "\n"
1282 << "# columns: " << columns () << "\n"
1283 << *complex_matrix ;
1284 break;
1285 case string_constant:
1286 os << "string\n"
1287 << "# length: " << strlen (string) << "\n"
1288 << string << "\n";
1289 break;
1290 case range_constant:
1291 {
1292 os << "range\n"
1293 << "# base, limit, increment\n"
1294 << range->base () << " "
1295 << range->limit () << " "
1296 << range->inc () << "\n";
1297 }
1298 break;
1299 case magic_colon:
1300 default:
1301 panic_impossible ();
1302 break;
1303 }
1304 // Really want to return 1 only if write is successful.
1305 return 1;
1306 }
1307
1308 int
1309 tree_constant_rep::save_three_d (ostream& os, int parametric)
1310 {
1311 int nr = rows ();
1312 int nc = columns ();
1313
1314 switch (type_tag)
1315 {
1316 case matrix_constant:
1317 os << "# 3D data...\n"
1318 << "# type: matrix\n"
1319 << "# total rows: " << nr << "\n"
1320 << "# total columns: " << nc << "\n";
1321
1322 if (parametric)
1323 {
1324 int extras = nc % 3;
1325 if (extras)
1326 warning ("ignoring last %d columns", extras);
1327
1328 for (int i = 0; i < nc-extras; i += 3)
1329 {
1330 os << matrix->extract (0, i, nr-1, i+2);
1331 if (i+3 < nc-extras)
1332 os << "\n";
1333 }
1334 }
1335 else
1336 {
1337 for (int i = 0; i < nc; i++)
1338 {
1339 os << matrix->extract (0, i, nr-1, i);
1340 if (i+1 < nc)
1341 os << "\n";
1342 }
1343 }
1344 break;
1345 default:
1346 error ("for now, I can only save real matrices in 3D format");
1347 return 0;
1348 break;
1349 }
1350 // Really want to return 1 only if write is successful.
1351 return 1;
1352 }
1353
1354 int
1355 tree_constant_rep::load (istream& is)
1356 {
1357 int is_global = 0;
1358
1359 type_tag = unknown_constant;
1360
1361 // Look for type keyword
1362 char tag [128];
1363 if (extract_keyword (is, "type", tag))
1364 {
1365 if (tag != (char *) NULL && *tag != '\0')
1366 {
1367 char *ptr = strchr (tag, ' ');
1368 if (ptr != (char *) NULL)
1369 {
1370 *ptr = '\0';
1371 is_global = (strncmp (tag, "global", 6) == 0);
1372 *ptr = ' ';
1373 ptr++;
1374 }
1375 else
1376 ptr = &tag[0];
1377
1378 if (strncmp (ptr, "scalar", 6) == 0)
1379 type_tag = load (is, scalar_constant);
1380 else if (strncmp (ptr, "matrix", 6) == 0)
1381 type_tag = load (is, matrix_constant);
1382 else if (strncmp (ptr, "complex scalar", 14) == 0)
1383 type_tag = load (is, complex_scalar_constant);
1384 else if (strncmp (ptr, "complex matrix", 14) == 0)
1385 type_tag = load (is, complex_matrix_constant);
1386 else if (strncmp (ptr, "string", 6) == 0)
1387 type_tag = load (is, string_constant);
1388 else if (strncmp (ptr, "range", 5) == 0)
1389 type_tag = load (is, range_constant);
1390 else
1391 error ("unknown constant type `%s'", tag);
1392 }
1393 else
1394 error ("failed to extract keyword specifying value type");
1395 }
1396
1397 return is_global;
1398 }
1399
1400 tree_constant_rep::constant_type
1401 tree_constant_rep::load (istream& is, tree_constant_rep::constant_type t)
1402 {
1403 tree_constant_rep::constant_type status = unknown_constant;
1404
1405 switch (t)
1406 {
1407 case scalar_constant:
1408 is >> scalar;
1409 if (is)
1410 status = scalar_constant;
1411 else
1412 error ("failed to load scalar constant");
1413 break;
1414 case matrix_constant:
1415 {
1416 int nr = 0, nc = 0;
1417
1418 if (extract_keyword (is, "rows", nr) && nr > 0
1419 && extract_keyword (is, "columns", nc) && nc > 0)
1420 {
1421 matrix = new Matrix (nr, nc);
1422 is >> *matrix;
1423 if (is)
1424 status = matrix_constant;
1425 else
1426 error ("failed to load matrix constant");
1427 }
1428 else
1429 error ("failed to extract number of rows and columns");
1430 }
1431 break;
1432 case complex_scalar_constant:
1433 is >> *complex_scalar;
1434 if (is)
1435 status = complex_scalar_constant;
1436 else
1437 error ("failed to load complex scalar constant");
1438 break;
1439 case complex_matrix_constant:
1440 {
1441 int nr = 0, nc = 0;
1442
1443 if (extract_keyword (is, "rows", nr) && nr > 0
1444 && extract_keyword (is, "columns", nc) && nc > 0)
1445 {
1446 complex_matrix = new ComplexMatrix (nr, nc);
1447 is >> *complex_matrix;
1448 if (is)
1449 status = complex_matrix_constant;
1450 else
1451 error ("failed to load complex matrix constant");
1452 }
1453 else
1454 error ("failed to extract number of rows and columns");
1455 }
1456 break;
1457 case string_constant:
1458 {
1459 int len;
1460 if (extract_keyword (is, "length", len) && len > 0)
1461 {
1462 string = new char [len+1];
1463 is.get (string, len+1, EOF);
1464 if (is)
1465 status = string_constant;
1466 else
1467 error ("failed to load string constant");
1468 }
1469 else
1470 error ("failed to extract string length");
1471 }
1472 break;
1473 case range_constant:
1474 skip_comments (is);
1475 range = new Range ();
1476 is >> *range;
1477 if (is)
1478 status = range_constant;
1479 else
1480 error ("failed to load range constant");
1481 break;
1482 default:
1483 panic_impossible ();
1484 break;
1485 }
1486 return status;
1487 }
1488
1489 double
1490 tree_constant_rep::double_value (void)
1491 {
1492 assert (type_tag == scalar_constant || type_tag == complex_scalar_constant);
1493
1494 if (type_tag == scalar_constant)
1495 return scalar;
1496 else if (type_tag == complex_scalar_constant)
1497 {
1498 int flag = user_pref.ok_to_lose_imaginary_part;
1499 if (flag == -1)
1500 warning ("implicit conversion of complex value to real value");
1501
1502 if (flag != 0)
1503 return real (*complex_scalar);
1504 else
1505 {
1506 error ("implicit conversion of complex value to real value not allowed");
1507 jump_to_top_level ();
1508 }
1509 }
1510 }
1511
1512 Matrix
1513 tree_constant_rep::matrix_value (void)
1514 {
1515 assert (type_tag == matrix_constant || type_tag == complex_matrix_constant);
1516
1517 if (type_tag == matrix_constant)
1518 return *matrix;
1519 else if (type_tag == complex_matrix_constant)
1520 {
1521 int flag = user_pref.ok_to_lose_imaginary_part;
1522 if (flag == -1)
1523 warning ("implicit conversion of complex matrix to real matrix");
1524
1525 if (flag != 0)
1526 return real (*complex_matrix);
1527 else
1528 {
1529 error ("implicit conversion of complex matrix to real matrix not allowed");
1530 jump_to_top_level ();
1531 }
1532 }
1533 }
1534
1535 Complex
1536 tree_constant_rep::complex_value (void)
1537 {
1538 assert (type_tag == complex_scalar_constant);
1539 return *complex_scalar;
1540 }
1541
1542 ComplexMatrix
1543 tree_constant_rep::complex_matrix_value (void)
1544 {
1545 assert (type_tag == complex_matrix_constant);
1546 return *complex_matrix;
1547 }
1548
1549 char *
1550 tree_constant_rep::string_value (void)
1551 {
1552 assert (type_tag == string_constant);
1553 return string;
1554 }
1555
1556 Range
1557 tree_constant_rep::range_value (void)
1558 {
1559 assert (type_tag == range_constant);
1560 return *range;
1561 }
1562
1563 int
1564 tree_constant_rep::rows (void)
1565 {
1566 int retval = -1;
1567 switch (type_tag)
1568 {
1569 case scalar_constant:
1570 case complex_scalar_constant:
1571 case string_constant:
1572 case range_constant:
1573 retval = 1;
1574 break;
1575 case matrix_constant:
1576 retval = matrix->rows ();
1577 break;
1578 case complex_matrix_constant:
1579 retval = complex_matrix->rows ();
1580 break;
1581 case magic_colon:
1582 error ("invalid use of colon operator");
1583 break;
1584 case unknown_constant:
1585 retval = 0;
1586 break;
1587 default:
1588 panic_impossible ();
1589 break;
1590 }
1591 return retval;
1592 }
1593
1594 int
1595 tree_constant_rep::columns (void)
1596 {
1597 int retval = -1;
1598 switch (type_tag)
1599 {
1600 case scalar_constant:
1601 case complex_scalar_constant:
1602 retval = 1;
1603 break;
1604 case matrix_constant:
1605 retval = matrix->columns ();
1606 break;
1607 case complex_matrix_constant:
1608 retval = complex_matrix->columns ();
1609 break;
1610 case string_constant:
1611 retval = strlen (string);
1612 break;
1613 case range_constant:
1614 retval = range->nelem ();
1615 break;
1616 case magic_colon:
1617 error ("invalid use of colon operator");
1618 break;
1619 case unknown_constant:
1620 retval = 0;
1621 break;
1622 default:
1623 panic_impossible ();
1624 break;
1625 }
1626 return retval;
1627 }
1628
1629 tree_constant
1630 tree_constant_rep::all (void)
1631 {
1632 if (type_tag == string_constant || type_tag == range_constant)
1633 {
1634 tree_constant tmp = make_numeric ();
1635 return tmp.all ();
1636 }
1637
1638 tree_constant retval;
1639 switch (type_tag)
1640 {
1641 case scalar_constant:
1642 {
1643 double status = (scalar != 0.0);
1644 retval = tree_constant (status);
1645 }
1646 break;
1647 case matrix_constant:
1648 {
1649 Matrix m = matrix->all ();
1650 retval = tree_constant (m);
1651 }
1652 break;
1653 case complex_scalar_constant:
1654 {
1655 double status = (*complex_scalar != 0.0);
1656 retval = tree_constant (status);
1657 }
1658 break;
1659 case complex_matrix_constant:
1660 {
1661 Matrix m = complex_matrix->all ();
1662 retval = tree_constant (m);
1663 }
1664 break;
1665 case string_constant:
1666 case range_constant:
1667 case magic_colon:
1668 default:
1669 panic_impossible ();
1670 break;
1671 }
1672 return retval;
1673 }
1674
1675 tree_constant
1676 tree_constant_rep::any (void)
1677 {
1678 if (type_tag == string_constant || type_tag == range_constant)
1679 {
1680 tree_constant tmp = make_numeric ();
1681 return tmp.any ();
1682 }
1683
1684 tree_constant retval;
1685 switch (type_tag)
1686 {
1687 case scalar_constant:
1688 {
1689 double status = (scalar != 0.0);
1690 retval = tree_constant (status);
1691 }
1692 break;
1693 case matrix_constant:
1694 {
1695 Matrix m = matrix->any ();
1696 retval = tree_constant (m);
1697 }
1698 break;
1699 case complex_scalar_constant:
1700 {
1701 double status = (*complex_scalar != 0.0);
1702 retval = tree_constant (status);
1703 }
1704 break;
1705 case complex_matrix_constant:
1706 {
1707 Matrix m = complex_matrix->any ();
1708 retval = tree_constant (m);
1709 }
1710 break;
1711 case string_constant:
1712 case range_constant:
1713 case magic_colon:
1714 default:
1715 panic_impossible ();
1716 break;
1717 }
1718 return retval;
1719 }
1720
1721 tree_constant
1722 tree_constant_rep::isstr (void)
1723 {
1724 double status = 0.0;
1725 if (const_type () == string_constant)
1726 status = 1.0;
1727 tree_constant retval (status);
1728 return retval;
1729 }
1730
1731 tree_constant
1732 tree_constant_rep::convert_to_str (void)
1733 {
1734 tree_constant retval;
1735
1736 switch (type_tag)
1737 {
1738 case complex_scalar_constant:
1739 case scalar_constant:
1740 {
1741 double d = double_value ();
1742 int i = NINT (d);
1743 // Warn about out of range conversions?
1744 char s[2];
1745 s[0] = (char) i;
1746 retval = tree_constant (s);
1747 }
1748 break;
1749 case complex_matrix_constant:
1750 case matrix_constant:
1751 {
1752 ColumnVector v = to_vector ();
1753 int len = v.length ();
1754 if (len == 0)
1755 error ("can only convert vectors and scalars to strings");
1756 else
1757 {
1758 char *s = new char [len+1];
1759 s[len] = '\0';
1760 for (int i = 0; i < len; i++)
1761 {
1762 double d = v.elem (i);
1763 int ival = NINT (d);
1764 // Warn about out of range conversions?
1765 s[i] = (char) ival;
1766 }
1767 retval = tree_constant (s);
1768 delete [] s;
1769 }
1770 }
1771 break;
1772 case range_constant:
1773 {
1774 Range r = range_value ();
1775 double b = r.base ();
1776 double incr = r.inc ();
1777 int nel = r.nelem ();
1778 char *s = new char [nel+1];
1779 s[nel] = '\0';
1780 for (int i = 0; i < nel; i++)
1781 {
1782 double d = b + i * incr;
1783 int ival = NINT (d);
1784 // Warn about out of range conversions?
1785 s[i] = (char) ival;
1786 }
1787 retval = tree_constant (s);
1788 delete [] s;
1789 }
1790 break;
1791 case string_constant:
1792 retval = tree_constant (*this);
1793 break;
1794 case magic_colon:
1795 default:
1796 panic_impossible ();
1797 break;
1798 }
1799 return retval;
1800 }
1801
1802 tree_constant
1803 tree_constant_rep::cumprod (void)
1804 {
1805 if (type_tag == string_constant || type_tag == range_constant)
1806 {
1807 tree_constant tmp = make_numeric ();
1808 return tmp.cumprod ();
1809 }
1810
1811 tree_constant retval;
1812 switch (type_tag)
1813 {
1814 case scalar_constant:
1815 retval = tree_constant (scalar);
1816 break;
1817 case matrix_constant:
1818 {
1819 Matrix m = matrix->cumprod ();
1820 retval = tree_constant (m);
1821 }
1822 break;
1823 case complex_scalar_constant:
1824 retval = tree_constant (*complex_scalar);
1825 break;
1826 case complex_matrix_constant:
1827 {
1828 ComplexMatrix m = complex_matrix->cumprod ();
1829 retval = tree_constant (m);
1830 }
1831 break;
1832 case string_constant:
1833 case range_constant:
1834 case magic_colon:
1835 default:
1836 panic_impossible ();
1837 break;
1838 }
1839 return retval;
1840 }
1841
1842 tree_constant
1843 tree_constant_rep::cumsum (void)
1844 {
1845 if (type_tag == string_constant || type_tag == range_constant)
1846 {
1847 tree_constant tmp = make_numeric ();
1848 return tmp.cumsum ();
1849 }
1850
1851 tree_constant retval;
1852 switch (type_tag)
1853 {
1854 case scalar_constant:
1855 retval = tree_constant (scalar);
1856 break;
1857 case matrix_constant:
1858 {
1859 Matrix m = matrix->cumsum ();
1860 retval = tree_constant (m);
1861 }
1862 break;
1863 case complex_scalar_constant:
1864 retval = tree_constant (*complex_scalar);
1865 break;
1866 case complex_matrix_constant:
1867 {
1868 ComplexMatrix m = complex_matrix->cumsum ();
1869 retval = tree_constant (m);
1870 }
1871 break;
1872 case string_constant:
1873 case range_constant:
1874 case magic_colon:
1875 default:
1876 panic_impossible ();
1877 break;
1878 }
1879 return retval;
1880 }
1881
1882 tree_constant
1883 tree_constant_rep::prod (void)
1884 {
1885 if (type_tag == string_constant || type_tag == range_constant)
1886 {
1887 tree_constant tmp = make_numeric ();
1888 return tmp.prod ();
1889 }
1890
1891 tree_constant retval;
1892 switch (type_tag)
1893 {
1894 case scalar_constant:
1895 retval = tree_constant (scalar);
1896 break;
1897 case matrix_constant:
1898 {
1899 Matrix m = matrix->prod ();
1900 retval = tree_constant (m);
1901 }
1902 break;
1903 case complex_scalar_constant:
1904 retval = tree_constant (*complex_scalar);
1905 break;
1906 case complex_matrix_constant:
1907 {
1908 ComplexMatrix m = complex_matrix->prod ();
1909 retval = tree_constant (m);
1910 }
1911 break;
1912 case string_constant:
1913 case range_constant:
1914 case magic_colon:
1915 default:
1916 panic_impossible ();
1917 break;
1918 }
1919 return retval;
1920 }
1921
1922 tree_constant
1923 tree_constant_rep::sum (void)
1924 {
1925 if (type_tag == string_constant || type_tag == range_constant)
1926 {
1927 tree_constant tmp = make_numeric ();
1928 return tmp.sum ();
1929 }
1930
1931 tree_constant retval;
1932 switch (type_tag)
1933 {
1934 case scalar_constant:
1935 retval = tree_constant (scalar);
1936 break;
1937 case matrix_constant:
1938 {
1939 Matrix m = matrix->sum ();
1940 retval = tree_constant (m);
1941 }
1942 break;
1943 case complex_scalar_constant:
1944 retval = tree_constant (*complex_scalar);
1945 break;
1946 case complex_matrix_constant:
1947 {
1948 ComplexMatrix m = complex_matrix->sum ();
1949 retval = tree_constant (m);
1950 }
1951 break;
1952 case string_constant:
1953 case range_constant:
1954 case magic_colon:
1955 default:
1956 panic_impossible ();
1957 break;
1958 }
1959 return retval;
1960 }
1961
1962 tree_constant
1963 tree_constant_rep::sumsq (void)
1964 {
1965 if (type_tag == string_constant || type_tag == range_constant)
1966 {
1967 tree_constant tmp = make_numeric ();
1968 return tmp.sumsq ();
1969 }
1970
1971 tree_constant retval;
1972 switch (type_tag)
1973 {
1974 case scalar_constant:
1975 retval = tree_constant (scalar * scalar);
1976 break;
1977 case matrix_constant:
1978 {
1979 Matrix m = matrix->sumsq ();
1980 retval = tree_constant (m);
1981 }
1982 break;
1983 case complex_scalar_constant:
1984 {
1985 Complex c (*complex_scalar);
1986 retval = tree_constant (c * c);
1987 }
1988 break;
1989 case complex_matrix_constant:
1990 {
1991 ComplexMatrix m = complex_matrix->sumsq ();
1992 retval = tree_constant (m);
1993 }
1994 break;
1995 case string_constant:
1996 case range_constant:
1997 case magic_colon:
1998 default:
1999 panic_impossible ();
2000 break;
2001 }
2002 return retval;
2003 }
2004
2005 static tree_constant
2006 make_diag (Matrix& v, int k)
2007 {
2008 int nr = v.rows ();
2009 int nc = v.columns ();
2010 assert (nc == 1 || nr == 1);
2011
2012 tree_constant retval;
2013
2014 int roff = 0;
2015 int coff = 0;
2016 if (k > 0)
2017 {
2018 roff = 0;
2019 coff = k;
2020 }
2021 else if (k < 0)
2022 {
2023 roff = -k;
2024 coff = 0;
2025 }
2026
2027 if (nr == 1)
2028 {
2029 int n = nc + ABS (k);
2030 Matrix m (n, n, 0.0);
2031 for (int i = 0; i < nc; i++)
2032 m.elem (i+roff, i+coff) = v.elem (0, i);
2033 retval = tree_constant (m);
2034 }
2035 else
2036 {
2037 int n = nr + ABS (k);
2038 Matrix m (n, n, 0.0);
2039 for (int i = 0; i < nr; i++)
2040 m.elem (i+roff, i+coff) = v.elem (i, 0);
2041 retval = tree_constant (m);
2042 }
2043
2044 return retval;
2045 }
2046
2047 static tree_constant
2048 make_diag (ComplexMatrix& v, int k)
2049 {
2050 int nr = v.rows ();
2051 int nc = v.columns ();
2052 assert (nc == 1 || nr == 1);
2053
2054 tree_constant retval;
2055
2056 int roff = 0;
2057 int coff = 0;
2058 if (k > 0)
2059 {
2060 roff = 0;
2061 coff = k;
2062 }
2063 else if (k < 0)
2064 {
2065 roff = -k;
2066 coff = 0;
2067 }
2068
2069 if (nr == 1)
2070 {
2071 int n = nc + ABS (k);
2072 ComplexMatrix m (n, n, 0.0);
2073 for (int i = 0; i < nc; i++)
2074 m.elem (i+roff, i+coff) = v.elem (0, i);
2075 retval = tree_constant (m);
2076 }
2077 else
2078 {
2079 int n = nr + ABS (k);
2080 ComplexMatrix m (n, n, 0.0);
2081 for (int i = 0; i < nr; i++)
2082 m.elem (i+roff, i+coff) = v.elem (i, 0);
2083 retval = tree_constant (m);
2084 }
2085
2086 return retval;
2087 }
2088
2089 tree_constant
2090 tree_constant_rep::diag (void)
2091 {
2092 if (type_tag == string_constant || type_tag == range_constant)
2093 {
2094 tree_constant tmp = make_numeric ();
2095 return tmp.diag ();
2096 }
2097
2098 tree_constant retval;
2099 switch (type_tag)
2100 {
2101 case scalar_constant:
2102 retval = tree_constant (scalar);
2103 break;
2104 case matrix_constant:
2105 {
2106 int nr = rows ();
2107 int nc = columns ();
2108 if (nr == 1 || nc == 1)
2109 retval = make_diag (matrix_value (), 0);
2110 else
2111 {
2112 ColumnVector v = matrix->diag ();
2113 if (v.capacity () > 0)
2114 retval = tree_constant (v);
2115 }
2116 }
2117 break;
2118 case complex_scalar_constant:
2119 retval = tree_constant (*complex_scalar);
2120 break;
2121 case complex_matrix_constant:
2122 {
2123 int nr = rows ();
2124 int nc = columns ();
2125 if (nr == 1 || nc == 1)
2126 retval = make_diag (complex_matrix_value (), 0);
2127 else
2128 {
2129 ComplexColumnVector v = complex_matrix->diag ();
2130 if (v.capacity () > 0)
2131 retval = tree_constant (v);
2132 }
2133 }
2134 break;
2135 case string_constant:
2136 case range_constant:
2137 case magic_colon:
2138 default:
2139 panic_impossible ();
2140 break;
2141 }
2142 return retval;
2143 }
2144
2145 tree_constant
2146 tree_constant_rep::diag (tree_constant& a)
2147 {
2148 if (type_tag == string_constant || type_tag == range_constant)
2149 {
2150 tree_constant tmp = make_numeric ();
2151 return tmp.diag (a);
2152 }
2153
2154 tree_constant tmp_a = a.make_numeric ();
2155
2156 tree_constant_rep::constant_type a_type = tmp_a.const_type ();
2157
2158 tree_constant retval;
2159
2160 switch (type_tag)
2161 {
2162 case scalar_constant:
2163 if (a_type == scalar_constant)
2164 {
2165 int k = NINT (tmp_a.double_value ());
2166 int n = ABS (k) + 1;
2167 if (k == 0)
2168 retval = tree_constant (scalar);
2169 else if (k > 0)
2170 {
2171 Matrix m (n, n, 0.0);
2172 m.elem (0, k) = scalar;
2173 retval = tree_constant (m);
2174 }
2175 else if (k < 0)
2176 {
2177 Matrix m (n, n, 0.0);
2178 m.elem (-k, 0) = scalar;
2179 retval = tree_constant (m);
2180 }
2181 }
2182 break;
2183 case matrix_constant:
2184 if (a_type == scalar_constant)
2185 {
2186 int k = NINT (tmp_a.double_value ());
2187 int nr = rows ();
2188 int nc = columns ();
2189 if (nr == 1 || nc == 1)
2190 retval = make_diag (matrix_value (), k);
2191 else
2192 {
2193 ColumnVector d = matrix->diag (k);
2194 retval = tree_constant (d);
2195 }
2196 }
2197 else
2198 message ("diag", "invalid second argument");
2199
2200 break;
2201 case complex_scalar_constant:
2202 if (a_type == scalar_constant)
2203 {
2204 int k = NINT (tmp_a.double_value ());
2205 int n = ABS (k) + 1;
2206 if (k == 0)
2207 retval = tree_constant (*complex_scalar);
2208 else if (k > 0)
2209 {
2210 ComplexMatrix m (n, n, 0.0);
2211 m.elem (0, k) = *complex_scalar;
2212 retval = tree_constant (m);
2213 }
2214 else if (k < 0)
2215 {
2216 ComplexMatrix m (n, n, 0.0);
2217 m.elem (-k, 0) = *complex_scalar;
2218 retval = tree_constant (m);
2219 }
2220 }
2221 break;
2222 case complex_matrix_constant:
2223 if (a_type == scalar_constant)
2224 {
2225 int k = NINT (tmp_a.double_value ());
2226 int nr = rows ();
2227 int nc = columns ();
2228 if (nr == 1 || nc == 1)
2229 retval = make_diag (complex_matrix_value (), k);
2230 else
2231 {
2232 ComplexColumnVector d = complex_matrix->diag (k);
2233 retval = tree_constant (d);
2234 }
2235 }
2236 else
2237 message ("diag", "invalid second argument");
2238
2239 break;
2240 case string_constant:
2241 case range_constant:
2242 case magic_colon:
2243 default:
2244 panic_impossible ();
2245 break;
2246 }
2247 return retval;
2248 }
2249
2250 void
2251 tree_constant_rep::print_if_string (ostream& os, int warn)
2252 {
2253 if (type_tag == string_constant)
2254 os << string << "\n";
2255 else if (warn)
2256 warning ("expecting string, found numeric constant");
2257 }
2258
2259 tree_constant
2260 tree_constant_rep::mapper (Mapper_fcn& m_fcn, int print)
2261 {
2262 tree_constant retval;
2263
2264 if (type_tag == string_constant || type_tag == range_constant)
2265 {
2266 tree_constant tmp = make_numeric ();
2267 return tmp.mapper (m_fcn, print);
2268 }
2269
2270 switch (type_tag)
2271 {
2272 case scalar_constant:
2273 if (m_fcn.neg_arg_complex && scalar < 0.0)
2274 {
2275 if (m_fcn.c_c_mapper != NULL)
2276 {
2277 Complex c = m_fcn.c_c_mapper (Complex (scalar));
2278 retval = tree_constant (c);
2279 }
2280 else
2281 panic_impossible ();
2282 }
2283 else
2284 {
2285 if (m_fcn.d_d_mapper != NULL)
2286 {
2287 double d = m_fcn.d_d_mapper (scalar);
2288 retval = tree_constant (d);
2289 }
2290 else
2291 panic_impossible ();
2292 }
2293 break;
2294 case matrix_constant:
2295 if (m_fcn.neg_arg_complex && any_element_is_negative (*matrix))
2296 {
2297 if (m_fcn.c_c_mapper != NULL)
2298 {
2299 ComplexMatrix cm = map (m_fcn.c_c_mapper,
2300 ComplexMatrix (*matrix));
2301 retval = tree_constant (cm);
2302 }
2303 else
2304 panic_impossible ();
2305 }
2306 else
2307 {
2308 if (m_fcn.d_d_mapper != NULL)
2309 {
2310 Matrix m = map (m_fcn.d_d_mapper, *matrix);
2311 retval = tree_constant (m);
2312 }
2313 else
2314 panic_impossible ();
2315 }
2316 break;
2317 case complex_scalar_constant:
2318 if (m_fcn.d_c_mapper != NULL)
2319 {
2320 double d;
2321 d = m_fcn.d_c_mapper (*complex_scalar);
2322 retval = tree_constant (d);
2323 }
2324 else if (m_fcn.c_c_mapper != NULL)
2325 {
2326 Complex c;
2327 c = m_fcn.c_c_mapper (*complex_scalar);
2328 retval = tree_constant (c);
2329 }
2330 else
2331 panic_impossible ();
2332 break;
2333 case complex_matrix_constant:
2334 if (m_fcn.d_c_mapper != NULL)
2335 {
2336 Matrix m;
2337 m = map (m_fcn.d_c_mapper, *complex_matrix);
2338 retval = tree_constant (m);
2339 }
2340 else if (m_fcn.c_c_mapper != NULL)
2341 {
2342 ComplexMatrix cm;
2343 cm = map (m_fcn.c_c_mapper, *complex_matrix);
2344 retval = tree_constant (cm);
2345 }
2346 else
2347 panic_impossible ();
2348 break;
2349 case string_constant:
2350 case range_constant:
2351 case magic_colon:
2352 default:
2353 panic_impossible ();
2354 break;
2355 }
2356
2357 if (retval.is_defined ())
2358 return retval.eval (print);
2359 else
2360 return retval;
2361 }
2362
2363 tree_constant::~tree_constant (void)
2364 {
2365 #if defined (MDEBUG)
2366 cerr << "~tree_constant: rep: " << rep
2367 << " rep->count: " << rep->count << "\n";
2368 #endif
2369
2370 if (--rep->count <= 0)
2371 {
2372 delete rep;
2373 rep = (tree_constant_rep *) NULL;
2374 }
2375 }
2376
2377 #if defined (MDEBUG)
2378 void *
2379 tree_constant::operator new (size_t size)
2380 {
2381 tree_constant *p = ::new tree_constant;
2382 cerr << "tree_constant::new(): " << p << "\n";
2383 return p;
2384 }
2385
2386 void
2387 tree_constant::operator delete (void *p, size_t size)
2388 {
2389 cerr << "tree_constant::delete(): " << p << "\n";
2390 ::delete p;
2391 }
2392 #endif
2393
2394 /*
2395 ;;; Local Variables: ***
2396 ;;; mode: C++ ***
2397 ;;; page-delimiter: "^/\\*" ***
2398 ;;; End: ***
2399 */