Mercurial > octave-nkf

comparison src/pt-exp.cc @ 2980:cd5ad3fd8049

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1997-05-16 01:12:13 by jwe]
author jwe
date Fri, 16 May 1997 01:13:19 +0000
parents a3556d2adec9
children 20f5cec4f11c
comparison
equal deleted inserted replaced
2979:a3556d2adec9 2980:cd5ad3fd8049
26 26
27 #ifdef HAVE_CONFIG_H 27 #ifdef HAVE_CONFIG_H
28 #include <config.h> 28 #include <config.h>
29 #endif 29 #endif
30 30
31 #include <string>
32
31 #include <iostream.h> 33 #include <iostream.h>
32 #include <strstream.h> 34 #include <strstream.h>
33 35
34 #include "defun.h"
35 #include "error.h" 36 #include "error.h"
36 #include "gripes.h" 37 #include "pager.h"
37 #include "help.h"
38 #include "input.h"
39 #include "oct-obj.h"
40 #include "oct-lvalue.h" 38 #include "oct-lvalue.h"
41 #include "pager.h"
42 #include "ov.h" 39 #include "ov.h"
43 #include "pt-exp.h" 40 #include "pt-exp.h"
44 #include "pt-id.h"
45 #include "pt-indir.h"
46 #include "pt-misc.h"
47 #include "pt-pr-code.h"
48 #include "pt-walk.h"
49 #include "utils.h"
50 #include "variables.h"
51 41
52 // Nonzero means we're returning from a function. 42 // Expressions.
53 extern int returning;
54 43
55 // Nonzero means we're breaking out of a loop or function body. 44 bool
56 extern int breaking; 45 tree_expression::is_logically_true (const char *warn_for)
46 {
47 bool expr_value = false;
57 48
58 // TRUE means print the right hand side of an assignment instead of 49 octave_value t1 = rvalue ();
59 // the left.
60 static bool Vprint_rhs_assign_val;
61 50
62 // Prefix expressions. 51 if (! error_state)
52 {
53 if (t1.is_defined ())
54 return t1.is_true ();
55 else
56 ::error ("%s: undefined value used in conditional expression",
57 warn_for);
58 }
59 else
60 ::error ("%s: error evaluating conditional expression", warn_for);
63 61
64 octave_value_list 62 return expr_value;
65 tree_prefix_expression::rvalue (int nargout)
66 {
67 octave_value_list retval;
68
69 if (nargout > 1)
70 error ("prefix operator `%s': invalid number of output arguments",
71 oper () . c_str ());
72 else
73 retval = rvalue ();
74
75 return retval;
76 } 63 }
77 64
78 octave_value 65 octave_value
79 tree_prefix_expression::rvalue (void) 66 tree_expression::rvalue (void)
80 { 67 {
81 octave_value retval; 68 ::error ("invalid rvalue function called in expression");
82 69 return octave_value ();
83 if (error_state)
84 return retval;
85
86 if (op)
87 {
88 if (etype == unot || etype == uminus)
89 {
90 octave_value val = op->rvalue ();
91
92 if (! error_state)
93 {
94 if (val.is_defined ())
95 {
96 if (etype == unot)
97 retval = val.not ();
98 else
99 retval = val.uminus ();
100 }
101 else
102 error ("argument to prefix operator `%s' undefined",
103 oper () . c_str ());
104 }
105 }
106 else if (etype == increment || etype == decrement)
107 {
108 octave_lvalue ref = op->lvalue ();
109
110 if (! error_state)
111 {
112 if (ref.is_defined ())
113 {
114 if (etype == increment)
115 ref.increment ();
116 else
117 ref.decrement ();
118
119 retval = ref.value ();
120 }
121 else
122 error ("argument to prefix operator `%s' undefined",
123 oper () . c_str ());
124 }
125 }
126 else
127 error ("prefix operator %d not implemented", etype);
128 }
129
130 return retval;
131 } 70 }
132 71
133 void 72 octave_value_list
134 tree_prefix_expression::eval_error (void) 73 tree_expression::rvalue (int nargout)
135 { 74 {
136 if (error_state > 0) 75 ::error ("invalid rvalue function called in expression");
137 ::error ("evaluating prefix operator `%s' near line %d, column %d", 76 return octave_value_list ();
138 oper () . c_str (), line (), column ()); 77 }
78
79 octave_lvalue
80 tree_expression::lvalue (void)
81 {
82 ::error ("invalid lvalue function called in expression");
83 return octave_lvalue ();
139 } 84 }
140 85
141 string 86 string
142 tree_prefix_expression::oper (void) const 87 tree_expression::original_text (void) const
143 { 88 {
144 string retval = "<unknown>"; 89 return string ();
145
146 switch (etype)
147 {
148 case unot:
149 retval = "!";
150 break;
151
152 case uminus:
153 retval = "-";
154 break;
155
156 case increment:
157 retval = "++";
158 break;
159
160 case decrement:
161 retval = "--";
162 break;
163
164 default:
165 break;
166 }
167
168 return retval;
169 }
170
171 void
172 tree_prefix_expression::accept (tree_walker& tw)
173 {
174 tw.visit_prefix_expression (*this);
175 }
176
177 // Postfix expressions.
178
179 octave_value_list
180 tree_postfix_expression::rvalue (int nargout)
181 {
182 octave_value_list retval;
183
184 if (nargout > 1)
185 error ("postfix operator `%s': invalid number of output arguments",
186 oper () . c_str ());
187 else
188 retval = rvalue ();
189
190 return retval;
191 }
192
193 octave_value
194 tree_postfix_expression::rvalue (void)
195 {
196 octave_value retval;
197
198 if (error_state)
199 return retval;
200
201 if (op)
202 {
203 if (etype == transpose || etype == hermitian)
204 {
205 octave_value val = op->rvalue ();
206
207 if (! error_state)
208 {
209 if (val.is_defined ())
210 {
211 if (etype == transpose)
212 retval = val.transpose ();
213 else
214 retval = val.hermitian ();
215 }
216 else
217 error ("argument to postfix operator `%s' undefined",
218 oper () . c_str ());
219 }
220 }
221 else if (etype == increment || etype == decrement)
222 {
223 octave_lvalue ref = op->lvalue ();
224
225 if (! error_state)
226 {
227 if (ref.is_defined ())
228 {
229 retval = ref.value ();
230
231 if (etype == increment)
232 ref.increment ();
233 else
234 ref.decrement ();
235 }
236 else
237 error ("argument to postfix operator `%s' undefined",
238 oper () . c_str ());
239 }
240 }
241 else
242 error ("postfix operator %d not implemented", etype);
243 }
244
245 return retval;
246 }
247
248 void
249 tree_postfix_expression::eval_error (void)
250 {
251 if (error_state > 0)
252 ::error ("evaluating postfix operator `%s' near line %d, column %d",
253 oper () . c_str (), line (), column ());
254 }
255
256 string
257 tree_postfix_expression::oper (void) const
258 {
259 string retval = "<unknown>";
260
261 switch (etype)
262 {
263 case transpose:
264 retval = ".'";
265 break;
266
267 case hermitian:
268 retval = "'";
269 break;
270
271 case increment:
272 retval = "++";
273 break;
274
275 case decrement:
276 retval = "--";
277 break;
278
279 default:
280 break;
281 }
282
283 return retval;
284 }
285
286 void
287 tree_postfix_expression::accept (tree_walker& tw)
288 {
289 tw.visit_postfix_expression (*this);
290 }
291
292 // Binary expressions.
293
294 octave_value_list
295 tree_binary_expression::rvalue (int nargout)
296 {
297 octave_value_list retval;
298
299 if (nargout > 1)
300 error ("binary operator `%s': invalid number of output arguments",
301 oper () . c_str ());
302 else
303 retval = rvalue ();
304
305 return retval;
306 }
307
308 octave_value
309 tree_binary_expression::rvalue (void)
310 {
311 octave_value retval;
312
313 if (error_state)
314 return retval;
315
316 if (op_lhs)
317 {
318 octave_value a = op_lhs->rvalue ();
319
320 if (error_state)
321 eval_error ();
322 else if (a.is_defined () && op_rhs)
323 {
324 octave_value b = op_rhs->rvalue ();
325
326 if (error_state)
327 eval_error ();
328 else if (b.is_defined ())
329 {
330 retval = ::do_binary_op (etype, a, b);
331
332 if (error_state)
333 {
334 retval = octave_value ();
335 eval_error ();
336 }
337 }
338 else
339 eval_error ();
340 }
341 else
342 eval_error ();
343 }
344 else
345 eval_error ();
346
347 return retval;
348 }
349
350 void
351 tree_binary_expression::eval_error (void)
352 {
353 if (error_state > 0)
354 ::error ("evaluating binary operator `%s' near line %d, column %d",
355 oper () . c_str (), line (), column ());
356 }
357
358 string
359 tree_binary_expression::oper (void) const
360 {
361 return octave_value::binary_op_as_string (etype);
362 }
363
364 void
365 tree_binary_expression::accept (tree_walker& tw)
366 {
367 tw.visit_binary_expression (*this);
368 }
369
370 // Boolean expressions.
371
372 octave_value_list
373 tree_boolean_expression::rvalue (int nargout)
374 {
375 octave_value_list retval;
376
377 if (nargout > 1)
378 error ("binary operator `%s': invalid number of output arguments",
379 oper () . c_str ());
380 else
381 retval = rvalue ();
382
383 return retval;
384 }
385
386 octave_value
387 tree_boolean_expression::rvalue (void)
388 {
389 octave_value retval;
390
391 if (error_state)
392 return retval;
393
394 bool result = false;
395
396 if (op_lhs)
397 {
398 octave_value a = op_lhs->rvalue ();
399
400 if (error_state)
401 eval_error ();
402 else
403 {
404 bool a_true = a.is_true ();
405
406 if (error_state)
407 eval_error ();
408 else
409 {
410 if (a_true)
411 {
412 if (etype == bool_or)
413 {
414 result = true;
415 goto done;
416 }
417 }
418 else
419 {
420 if (etype == bool_and)
421 goto done;
422 }
423
424 if (op_rhs)
425 {
426 octave_value b = op_rhs->rvalue ();
427
428 if (error_state)
429 eval_error ();
430 else
431 {
432 result = b.is_true ();
433
434 if (error_state)
435 eval_error ();
436 }
437 }
438 else
439 eval_error ();
440
441 done:
442
443 if (! error_state)
444 retval = octave_value (static_cast<double> (result));
445 }
446 }
447 }
448 else
449 eval_error ();
450
451 return retval;
452 }
453
454 string
455 tree_boolean_expression::oper (void) const
456 {
457 string retval = "<unknown>";
458
459 switch (etype)
460 {
461 case bool_and:
462 retval = "&&";
463 break;
464
465 case bool_or:
466 retval = "||";
467 break;
468
469 default:
470 break;
471 }
472
473 return retval;
474 }
475
476 // Simple assignment expressions.
477
478 tree_simple_assignment::~tree_simple_assignment (void)
479 {
480 if (! preserve)
481 delete lhs;
482
483 delete rhs;
484 }
485
486 octave_value_list
487 tree_simple_assignment::rvalue (int nargout)
488 {
489 octave_value_list retval;
490
491 if (nargout > 1)
492 error ("invalid number of output arguments for expression X = RHS");
493 else
494 retval = rvalue ();
495
496 return retval;
497 }
498
499 octave_value
500 tree_simple_assignment::rvalue (void)
501 {
502 octave_value rhs_val;
503
504 if (error_state)
505 return rhs_val;
506
507 if (rhs)
508 {
509 octave_value_list tmp = rhs->rvalue ();
510
511 if (! (error_state || tmp.empty ()))
512 {
513 rhs_val = tmp(0);
514
515 if (rhs_val.is_undefined ())
516 {
517 error ("value on right hand side of assignment is undefined");
518 eval_error ();
519 }
520 else
521 {
522 octave_lvalue ult = lhs->lvalue ();
523
524 if (error_state)
525 eval_error ();
526 else
527 {
528 ult.assign (etype, rhs_val);
529
530 if (error_state)
531 eval_error ();
532 else if (! Vprint_rhs_assign_val)
533 {
534 octave_value lhs_val = ult.value ();
535
536 if (! error_state && print_result ())
537 {
538 if (Vprint_rhs_assign_val)
539 {
540 ostrstream buf;
541
542 tree_print_code tpc (buf);
543
544 lhs->accept (tpc);
545
546 buf << ends;
547
548 const char *tag = buf.str ();
549
550 rhs_val.print_with_name (octave_stdout, tag);
551
552 delete [] tag;
553 }
554 else
555 lhs_val.print_with_name (octave_stdout,
556 lhs->name ());
557 }
558 }
559 }
560 }
561 }
562 else
563 eval_error ();
564 }
565
566 return rhs_val;
567 }
568
569 void
570 tree_simple_assignment::eval_error (void)
571 {
572 if (error_state > 0)
573 {
574 int l = line ();
575 int c = column ();
576
577 if (l != -1 && c != -1)
578 ::error ("evaluating assignment expression near line %d, column %d",
579 l, c);
580 }
581 }
582
583 string
584 tree_simple_assignment::oper (void) const
585 {
586 return octave_value::assign_op_as_string (etype);
587 }
588
589 void
590 tree_simple_assignment::accept (tree_walker& tw)
591 {
592 tw.visit_simple_assignment (*this);
593 }
594
595 // Colon expressions.
596
597 tree_colon_expression *
598 tree_colon_expression::append (tree_expression *t)
599 {
600 tree_colon_expression *retval = 0;
601
602 if (op_base)
603 {
604 if (op_limit)
605 {
606 if (op_increment)
607 ::error ("invalid colon expression");
608 else
609 {
610 // Stupid syntax:
611 //
612 // base : limit
613 // base : increment : limit
614
615 op_increment = op_limit;
616 op_limit = t;
617 }
618 }
619 else
620 op_limit = t;
621
622 retval = this;
623 }
624 else
625 ::error ("invalid colon expression");
626
627 return retval;
628 }
629
630 octave_value_list
631 tree_colon_expression::rvalue (int nargout)
632 {
633 octave_value_list retval;
634
635 if (nargout > 1)
636 error ("invalid number of output arguments for colon expression");
637 else
638 retval = rvalue ();
639
640 return retval;
641 }
642
643 octave_value
644 tree_colon_expression::rvalue (void)
645 {
646 octave_value retval;
647
648 if (error_state || ! op_base || ! op_limit)
649 return retval;
650
651 octave_value tmp = op_base->rvalue ();
652
653 if (tmp.is_undefined ())
654 {
655 eval_error ("invalid null value in colon expression");
656 return retval;
657 }
658
659 double xbase = tmp.double_value ();
660
661 if (error_state)
662 {
663 eval_error ("colon expression elements must be scalars");
664 return retval;
665 }
666
667 tmp = op_limit->rvalue ();
668
669 if (tmp.is_undefined ())
670 {
671 eval_error ("invalid null value in colon expression");
672 return retval;
673 }
674
675 double xlimit = tmp.double_value ();
676
677 if (error_state)
678 {
679 eval_error ("colon expression elements must be scalars");
680 return retval;
681 }
682
683 double xinc = 1.0;
684
685 if (op_increment)
686 {
687 tmp = op_increment->rvalue ();
688
689 if (tmp.is_undefined ())
690 {
691 eval_error ("invalid null value in colon expression");
692 return retval;
693 }
694
695 xinc = tmp.double_value ();
696
697 if (error_state)
698 {
699 eval_error ("colon expression elements must be scalars");
700 return retval;
701 }
702 }
703
704 retval = octave_value (xbase, xlimit, xinc);
705
706 if (error_state)
707 {
708 if (error_state)
709 eval_error ();
710
711 return octave_value ();
712 }
713
714 return retval;
715 }
716
717 void
718 tree_colon_expression::eval_error (const string& s)
719 {
720 if (error_state > 0)
721 {
722 if (! s.empty ())
723 ::error ("%s", s.c_str ());
724
725 ::error ("evaluating colon expression near line %d column %d",
726 line (), column ());
727 }
728 }
729
730 void
731 tree_colon_expression::accept (tree_walker& tw)
732 {
733 tw.visit_colon_expression (*this);
734 }
735
736 tree_index_expression::~tree_index_expression (void)
737 {
738 delete expr;
739 delete list;
740 }
741
742 octave_value_list
743 tree_index_expression::rvalue (int nargout)
744 {
745 octave_value_list retval;
746
747 if (error_state)
748 return retval;
749
750 octave_value tmp = expr->rvalue ();
751
752 if (! error_state)
753 {
754 octave_value_list args;
755
756 if (list)
757 args = list->convert_to_const_vector ();
758
759 if (! error_state)
760 {
761 if (! args.empty ())
762 args.stash_name_tags (arg_nm);
763
764 // XXX FIXME XXX -- is this the right thing to do?
765 if (tmp.is_constant ())
766 retval = tmp.do_index_op (args);
767 else
768 retval = tmp.do_index_op (nargout, args);
769 }
770 else
771 eval_error ();
772 }
773 else
774 eval_error ();
775
776 return retval;
777 }
778
779 octave_value
780 tree_index_expression::rvalue (void)
781 {
782 octave_value retval;
783
784 octave_value_list tmp = rvalue (1);
785
786 if (! tmp.empty ())
787 retval = tmp(0);
788
789 return retval;
790 }
791
792 octave_lvalue
793 tree_index_expression::lvalue (void)
794 {
795 octave_lvalue retval;
796
797 if (! error_state)
798 {
799 retval = expr->lvalue ();
800
801 if (! error_state)
802 {
803 octave_value_list args;
804
805 if (list)
806 args = list->convert_to_const_vector ();
807
808 retval.index (args);
809 }
810 }
811
812 return retval;
813 }
814
815 void
816 tree_index_expression::eval_error (void)
817 {
818 if (error_state > 0)
819 {
820 int l = line ();
821 int c = column ();
822
823 if (l != -1 && c != -1)
824 {
825 if (list)
826 ::error ("evaluating index expression near line %d, column %d",
827 l, c);
828 else
829 ::error ("evaluating expression near line %d, column %d", l, c);
830 }
831 else
832 {
833 if (list)
834 ::error ("evaluating index expression");
835 else
836 ::error ("evaluating expression");
837 }
838 }
839 }
840
841 void
842 tree_index_expression::accept (tree_walker& tw)
843 {
844 tw.visit_index_expression (*this);
845 }
846
847 tree_multi_assignment::~tree_multi_assignment (void)
848 {
849 if (! preserve)
850 delete lhs;
851
852 delete rhs;
853 }
854
855 octave_value
856 tree_multi_assignment::rvalue (void)
857 {
858 octave_value retval;
859
860 octave_value_list tmp = rvalue (1);
861
862 if (! tmp.empty ())
863 retval = tmp(0);
864
865 return retval;
866 }
867
868 octave_value_list
869 tree_multi_assignment::rvalue (int nargout)
870 {
871 octave_value_list rhs_val;
872
873 if (error_state)
874 return rhs_val;
875
876 if (rhs)
877 {
878 int n_out = lhs->length ();
879
880 rhs_val = rhs->rvalue (n_out);
881
882 if (! (error_state || rhs_val.empty ()))
883 {
884 if (rhs_val.empty ())
885 {
886 error ("value on right hand side of assignment is undefined");
887 eval_error ();
888 }
889 else
890 {
891 int k = 0;
892
893 int n = rhs_val.length ();
894
895 for (Pix p = lhs->first (); p != 0; lhs->next (p))
896 {
897 tree_expression *lhs_elt = lhs->operator () (p);
898
899 if (lhs_elt)
900 {
901 octave_lvalue ult = lhs_elt->lvalue ();
902
903 if (error_state)
904 eval_error ();
905 else
906 {
907 octave_value tmp = k < n
908 ? rhs_val(k++) : octave_value ();
909
910 if (tmp.is_defined ())
911 {
912 // XXX FIXME XXX -- handle other assignment ops.
913 ult.assign (octave_value::asn_eq, tmp);
914 }
915 else
916 error ("element number %d undefined in return list", k);
917
918 if (error_state)
919 eval_error ();
920 else if (! Vprint_rhs_assign_val)
921 {
922 octave_value lhs_val = ult.value ();
923
924 if (! error_state && print_result ())
925 {
926 if (Vprint_rhs_assign_val)
927 {
928 ostrstream buf;
929
930 tree_print_code tpc (buf);
931
932 lhs_elt->accept (tpc);
933
934 buf << ends;
935
936 const char *tag = buf.str ();
937
938 tmp.print_with_name
939 (octave_stdout, tag);
940
941 delete [] tag;
942 }
943 else
944 lhs_val.print_with_name (octave_stdout,
945 lhs_elt->name ());
946 }
947 }
948 }
949 }
950
951 if (error_state)
952 break;
953 }
954 }
955 }
956 else
957 eval_error ();
958 }
959
960 return rhs_val;
961 }
962
963 void
964 tree_multi_assignment::eval_error (void)
965 {
966 if (error_state > 0)
967 {
968 int l = line ();
969 int c = column ();
970
971 if (l != -1 && c != -1)
972 ::error ("evaluating assignment expression near line %d, column %d",
973 l, c);
974 }
975 }
976
977 void
978 tree_multi_assignment::accept (tree_walker& tw)
979 {
980 tw.visit_multi_assignment (*this);
981 }
982
983 static int
984 print_rhs_assign_val (void)
985 {
986 Vprint_rhs_assign_val = check_preference ("print_rhs_assign_val");
987
988 return 0;
989 }
990
991 void
992 symbols_of_pt_exp (void)
993 {
994 DEFVAR (print_rhs_assign_val, 0.0, 0, print_rhs_assign_val,
995 "if TRUE, print the right hand side of assignments instead of the left");
996 } 90 }
997 91
998 /* 92 /*
999 ;;; Local Variables: *** 93 ;;; Local Variables: ***
1000 ;;; mode: C++ *** 94 ;;; mode: C++ ***