1741
|
1 /* |
|
2 |
2847
|
3 Copyright (C) 1996, 1997 John W. Eaton |
1741
|
4 |
|
5 This file is part of Octave. |
|
6 |
|
7 Octave is free software; you can redistribute it and/or modify it |
|
8 under the terms of the GNU General Public License as published by the |
|
9 Free Software Foundation; either version 2, or (at your option) any |
|
10 later version. |
|
11 |
|
12 Octave is distributed in the hope that it will be useful, but WITHOUT |
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
15 for more details. |
|
16 |
|
17 You should have received a copy of the GNU General Public License |
|
18 along with Octave; see the file COPYING. If not, write to the Free |
|
19 Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. |
|
20 |
|
21 */ |
|
22 |
|
23 #if defined (__GNUG__) |
|
24 #pragma implementation |
|
25 #endif |
|
26 |
|
27 #ifdef HAVE_CONFIG_H |
|
28 #include <config.h> |
|
29 #endif |
|
30 |
|
31 #include <iostream.h> |
|
32 #include <strstream.h> |
|
33 |
|
34 #include "defun.h" |
|
35 #include "error.h" |
|
36 #include "gripes.h" |
|
37 #include "help.h" |
|
38 #include "input.h" |
|
39 #include "oct-obj.h" |
2955
|
40 #include "oct-var-ref.h" |
1741
|
41 #include "pager.h" |
2388
|
42 #include "ov.h" |
1741
|
43 #include "pt-exp.h" |
2891
|
44 #include "pt-id.h" |
|
45 #include "pt-indir.h" |
1741
|
46 #include "pt-misc.h" |
2388
|
47 #include "pt-pr-code.h" |
2124
|
48 #include "pt-walk.h" |
1741
|
49 #include "utils.h" |
2879
|
50 #include "variables.h" |
1741
|
51 |
|
52 // Nonzero means we're returning from a function. |
|
53 extern int returning; |
|
54 |
|
55 // Nonzero means we're breaking out of a loop or function body. |
|
56 extern int breaking; |
|
57 |
2958
|
58 // TRUE means print the right hand side of an assignment instead of |
|
59 // the left. |
|
60 static bool Vprint_rhs_assign_val; |
|
61 |
1741
|
62 // Prefix expressions. |
|
63 |
2971
|
64 octave_value_list |
|
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 } |
|
77 |
2086
|
78 octave_value |
2971
|
79 tree_prefix_expression::rvalue (void) |
1741
|
80 { |
2086
|
81 octave_value retval; |
1741
|
82 |
|
83 if (error_state) |
|
84 return retval; |
|
85 |
2960
|
86 if (op) |
1741
|
87 { |
2960
|
88 if (etype == unot || etype == uminus) |
2388
|
89 { |
2971
|
90 octave_value val = op->rvalue (); |
2388
|
91 |
2960
|
92 if (! error_state) |
1741
|
93 { |
2971
|
94 if (val.is_defined ()) |
|
95 { |
|
96 if (etype == unot) |
|
97 retval = val.not (); |
|
98 else |
|
99 retval = val.uminus (); |
|
100 } |
2960
|
101 else |
2971
|
102 error ("argument to prefix operator `%s' undefined", |
|
103 oper () . c_str ()); |
1741
|
104 } |
|
105 } |
2960
|
106 else if (etype == increment || etype == decrement) |
|
107 { |
2971
|
108 octave_variable_reference ref = op->lvalue (); |
2960
|
109 |
|
110 if (! error_state) |
|
111 { |
2971
|
112 if (ref.is_defined ()) |
|
113 { |
|
114 if (etype == increment) |
|
115 ref.increment (); |
|
116 else |
|
117 ref.decrement (); |
|
118 |
|
119 retval = ref.value (); |
|
120 } |
2960
|
121 else |
2971
|
122 error ("argument to prefix operator `%s' undefined", |
|
123 oper () . c_str ()); |
2960
|
124 } |
|
125 } |
|
126 else |
|
127 error ("prefix operator %d not implemented", etype); |
1741
|
128 } |
2960
|
129 |
1741
|
130 return retval; |
|
131 } |
|
132 |
2971
|
133 void |
|
134 tree_prefix_expression::eval_error (void) |
|
135 { |
|
136 if (error_state > 0) |
|
137 ::error ("evaluating prefix operator `%s' near line %d, column %d", |
|
138 oper () . c_str (), line (), column ()); |
|
139 } |
|
140 |
2900
|
141 string |
1741
|
142 tree_prefix_expression::oper (void) const |
|
143 { |
2900
|
144 string retval = "<unknown>"; |
|
145 |
1741
|
146 switch (etype) |
|
147 { |
2960
|
148 case unot: |
|
149 retval = "!"; |
|
150 break; |
|
151 |
|
152 case uminus: |
|
153 retval = "-"; |
|
154 break; |
|
155 |
2388
|
156 case increment: |
2900
|
157 retval = "++"; |
1741
|
158 break; |
|
159 |
2388
|
160 case decrement: |
2900
|
161 retval = "--"; |
1741
|
162 break; |
|
163 |
|
164 default: |
|
165 break; |
|
166 } |
2900
|
167 |
|
168 return retval; |
1741
|
169 } |
|
170 |
|
171 void |
2124
|
172 tree_prefix_expression::accept (tree_walker& tw) |
1741
|
173 { |
2124
|
174 tw.visit_prefix_expression (*this); |
1741
|
175 } |
|
176 |
|
177 // Postfix expressions. |
|
178 |
2971
|
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 |
2086
|
193 octave_value |
2971
|
194 tree_postfix_expression::rvalue (void) |
1741
|
195 { |
2086
|
196 octave_value retval; |
1741
|
197 |
|
198 if (error_state) |
|
199 return retval; |
|
200 |
2960
|
201 if (op) |
1741
|
202 { |
2960
|
203 if (etype == transpose || etype == hermitian) |
2388
|
204 { |
2971
|
205 octave_value val = op->rvalue (); |
2388
|
206 |
2960
|
207 if (! error_state) |
|
208 { |
2971
|
209 if (val.is_defined ()) |
|
210 { |
|
211 if (etype == transpose) |
|
212 retval = val.transpose (); |
|
213 else |
|
214 retval = val.hermitian (); |
|
215 } |
2960
|
216 else |
2971
|
217 error ("argument to postfix operator `%s' undefined", |
|
218 oper () . c_str ()); |
2960
|
219 } |
2388
|
220 } |
2960
|
221 else if (etype == increment || etype == decrement) |
1741
|
222 { |
2971
|
223 octave_variable_reference ref = op->lvalue (); |
2960
|
224 |
|
225 if (! error_state) |
|
226 { |
2971
|
227 if (ref.is_defined ()) |
|
228 { |
|
229 retval = ref.value (); |
2960
|
230 |
2971
|
231 if (etype == increment) |
|
232 ref.increment (); |
|
233 else |
|
234 ref.decrement (); |
|
235 } |
2960
|
236 else |
2971
|
237 error ("argument to postfix operator `%s' undefined", |
|
238 oper () . c_str ()); |
2960
|
239 } |
1741
|
240 } |
2960
|
241 else |
|
242 error ("postfix operator %d not implemented", etype); |
1741
|
243 } |
2960
|
244 |
1741
|
245 return retval; |
|
246 } |
|
247 |
2971
|
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 |
2900
|
256 string |
1741
|
257 tree_postfix_expression::oper (void) const |
|
258 { |
2900
|
259 string retval = "<unknown>"; |
|
260 |
1741
|
261 switch (etype) |
|
262 { |
2960
|
263 case transpose: |
|
264 retval = ".'"; |
|
265 break; |
|
266 |
|
267 case hermitian: |
|
268 retval = "'"; |
|
269 break; |
|
270 |
2388
|
271 case increment: |
2900
|
272 retval = "++"; |
1741
|
273 break; |
|
274 |
2388
|
275 case decrement: |
2900
|
276 retval = "--"; |
1741
|
277 break; |
|
278 |
|
279 default: |
|
280 break; |
|
281 } |
2900
|
282 |
|
283 return retval; |
1741
|
284 } |
|
285 |
|
286 void |
2124
|
287 tree_postfix_expression::accept (tree_walker& tw) |
1741
|
288 { |
2124
|
289 tw.visit_postfix_expression (*this); |
1741
|
290 } |
|
291 |
|
292 // Binary expressions. |
|
293 |
2971
|
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 |
2086
|
308 octave_value |
2971
|
309 tree_binary_expression::rvalue (void) |
1741
|
310 { |
2086
|
311 octave_value retval; |
1741
|
312 |
2388
|
313 if (error_state) |
|
314 return retval; |
|
315 |
|
316 if (op_lhs) |
1741
|
317 { |
2971
|
318 octave_value a = op_lhs->rvalue (); |
2388
|
319 |
|
320 if (error_state) |
|
321 eval_error (); |
|
322 else if (a.is_defined () && op_rhs) |
1741
|
323 { |
2971
|
324 octave_value b = op_rhs->rvalue (); |
2388
|
325 |
1741
|
326 if (error_state) |
|
327 eval_error (); |
2388
|
328 else if (b.is_defined ()) |
1741
|
329 { |
2879
|
330 retval = ::do_binary_op (etype, a, b); |
2388
|
331 |
2879
|
332 if (error_state) |
2388
|
333 { |
|
334 retval = octave_value (); |
|
335 eval_error (); |
1741
|
336 } |
|
337 } |
2388
|
338 else |
|
339 eval_error (); |
1741
|
340 } |
2388
|
341 else |
|
342 eval_error (); |
1741
|
343 } |
2388
|
344 else |
|
345 eval_error (); |
1741
|
346 |
|
347 return retval; |
|
348 } |
|
349 |
|
350 void |
|
351 tree_binary_expression::eval_error (void) |
|
352 { |
|
353 if (error_state > 0) |
2805
|
354 ::error ("evaluating binary operator `%s' near line %d, column %d", |
2900
|
355 oper () . c_str (), line (), column ()); |
1741
|
356 } |
|
357 |
2971
|
358 string |
|
359 tree_binary_expression::oper (void) const |
|
360 { |
|
361 return octave_value::binary_op_as_string (etype); |
|
362 } |
|
363 |
1741
|
364 void |
2124
|
365 tree_binary_expression::accept (tree_walker& tw) |
1741
|
366 { |
2124
|
367 tw.visit_binary_expression (*this); |
1741
|
368 } |
|
369 |
2388
|
370 // Boolean expressions. |
|
371 |
2971
|
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 |
2388
|
386 octave_value |
2971
|
387 tree_boolean_expression::rvalue (void) |
2388
|
388 { |
|
389 octave_value retval; |
|
390 |
|
391 if (error_state) |
|
392 return retval; |
|
393 |
|
394 bool result = false; |
|
395 |
|
396 if (op_lhs) |
|
397 { |
2971
|
398 octave_value a = op_lhs->rvalue (); |
2388
|
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 { |
2805
|
412 if (etype == bool_or) |
2388
|
413 { |
|
414 result = true; |
|
415 goto done; |
|
416 } |
|
417 } |
|
418 else |
|
419 { |
2805
|
420 if (etype == bool_and) |
2388
|
421 goto done; |
|
422 } |
|
423 |
|
424 if (op_rhs) |
|
425 { |
2971
|
426 octave_value b = op_rhs->rvalue (); |
2388
|
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) |
2800
|
444 retval = octave_value (static_cast<double> (result)); |
2388
|
445 } |
|
446 } |
|
447 } |
|
448 else |
|
449 eval_error (); |
|
450 |
|
451 return retval; |
|
452 } |
|
453 |
2900
|
454 string |
2388
|
455 tree_boolean_expression::oper (void) const |
|
456 { |
2900
|
457 string retval = "<unknown>"; |
|
458 |
2388
|
459 switch (etype) |
|
460 { |
2805
|
461 case bool_and: |
2900
|
462 retval = "&&"; |
2388
|
463 break; |
|
464 |
2805
|
465 case bool_or: |
2900
|
466 retval = "||"; |
2388
|
467 break; |
|
468 |
|
469 default: |
|
470 break; |
|
471 } |
2900
|
472 |
|
473 return retval; |
2388
|
474 } |
|
475 |
1741
|
476 // Simple assignment expressions. |
|
477 |
2971
|
478 tree_simple_assignment::~tree_simple_assignment (void) |
1741
|
479 { |
|
480 if (! preserve) |
2971
|
481 delete lhs; |
1741
|
482 |
|
483 delete rhs; |
|
484 } |
|
485 |
2971
|
486 octave_value_list |
|
487 tree_simple_assignment::rvalue (int nargout) |
1741
|
488 { |
2971
|
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; |
1741
|
497 } |
|
498 |
2086
|
499 octave_value |
2971
|
500 tree_simple_assignment::rvalue (void) |
1741
|
501 { |
2958
|
502 octave_value rhs_val; |
2665
|
503 |
1741
|
504 if (error_state) |
2958
|
505 return rhs_val; |
1741
|
506 |
|
507 if (rhs) |
|
508 { |
2971
|
509 octave_value_list tmp = rhs->rvalue (); |
2665
|
510 |
2971
|
511 if (! (error_state || tmp.empty ())) |
|
512 { |
|
513 rhs_val = tmp(0); |
2958
|
514 |
|
515 if (rhs_val.is_undefined ()) |
|
516 { |
|
517 error ("value on right hand side of assignment is undefined"); |
|
518 eval_error (); |
|
519 } |
1741
|
520 else |
|
521 { |
2971
|
522 octave_variable_reference ult = lhs->lvalue (); |
2958
|
523 |
|
524 if (error_state) |
|
525 eval_error (); |
|
526 else |
2388
|
527 { |
2971
|
528 ult.assign (etype, rhs_val); |
2958
|
529 |
2971
|
530 if (error_state) |
|
531 eval_error (); |
|
532 else if (! Vprint_rhs_assign_val) |
|
533 { |
|
534 octave_value lhs_val = ult.value (); |
1741
|
535 |
2971
|
536 if (! error_state && print_result ()) |
|
537 { |
|
538 if (Vprint_rhs_assign_val) |
2958
|
539 { |
2971
|
540 ostrstream buf; |
|
541 |
|
542 tree_print_code tpc (buf); |
2958
|
543 |
2971
|
544 lhs->accept (tpc); |
|
545 |
|
546 buf << ends; |
2388
|
547 |
2971
|
548 const char *tag = buf.str (); |
|
549 |
|
550 rhs_val.print_with_name (octave_stdout, tag); |
|
551 |
|
552 delete [] tag; |
2958
|
553 } |
|
554 else |
2971
|
555 lhs_val.print_with_name (octave_stdout, |
|
556 lhs->name ()); |
2958
|
557 } |
2388
|
558 } |
|
559 } |
1741
|
560 } |
|
561 } |
2958
|
562 else |
|
563 eval_error (); |
1741
|
564 } |
|
565 |
2958
|
566 return rhs_val; |
1741
|
567 } |
|
568 |
|
569 void |
2971
|
570 tree_simple_assignment::eval_error (void) |
1741
|
571 { |
|
572 if (error_state > 0) |
|
573 { |
|
574 int l = line (); |
|
575 int c = column (); |
1827
|
576 |
1741
|
577 if (l != -1 && c != -1) |
|
578 ::error ("evaluating assignment expression near line %d, column %d", |
|
579 l, c); |
|
580 } |
|
581 } |
|
582 |
2900
|
583 string |
2971
|
584 tree_simple_assignment::oper (void) const |
2879
|
585 { |
2900
|
586 return octave_value::assign_op_as_string (etype); |
2879
|
587 } |
|
588 |
1741
|
589 void |
2971
|
590 tree_simple_assignment::accept (tree_walker& tw) |
1741
|
591 { |
2971
|
592 tw.visit_simple_assignment (*this); |
1741
|
593 } |
|
594 |
|
595 // Colon expressions. |
|
596 |
|
597 tree_colon_expression * |
2971
|
598 tree_colon_expression::append (tree_expression *t) |
1741
|
599 { |
|
600 tree_colon_expression *retval = 0; |
2971
|
601 |
|
602 if (op_base) |
1741
|
603 { |
2971
|
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 |
2124
|
614 |
2971
|
615 op_increment = op_limit; |
|
616 op_limit = t; |
|
617 } |
|
618 } |
|
619 else |
|
620 op_limit = t; |
1741
|
621 |
|
622 retval = this; |
|
623 } |
2971
|
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 |
1741
|
640 return retval; |
|
641 } |
|
642 |
2086
|
643 octave_value |
2971
|
644 tree_colon_expression::rvalue (void) |
1741
|
645 { |
2086
|
646 octave_value retval; |
1741
|
647 |
2124
|
648 if (error_state || ! op_base || ! op_limit) |
1741
|
649 return retval; |
|
650 |
2971
|
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 (); |
1741
|
668 |
|
669 if (tmp.is_undefined ()) |
|
670 { |
|
671 eval_error ("invalid null value in colon expression"); |
|
672 return retval; |
|
673 } |
|
674 |
2971
|
675 double xlimit = tmp.double_value (); |
1741
|
676 |
|
677 if (error_state) |
|
678 { |
2971
|
679 eval_error ("colon expression elements must be scalars"); |
1741
|
680 return retval; |
|
681 } |
|
682 |
2971
|
683 double xinc = 1.0; |
2124
|
684 |
|
685 if (op_increment) |
1741
|
686 { |
2971
|
687 tmp = op_increment->rvalue (); |
1741
|
688 |
|
689 if (tmp.is_undefined ()) |
|
690 { |
|
691 eval_error ("invalid null value in colon expression"); |
|
692 return retval; |
|
693 } |
|
694 |
2971
|
695 xinc = tmp.double_value (); |
1741
|
696 |
|
697 if (error_state) |
|
698 { |
2971
|
699 eval_error ("colon expression elements must be scalars"); |
1741
|
700 return retval; |
|
701 } |
|
702 } |
|
703 |
2971
|
704 retval = octave_value (xbase, xlimit, xinc); |
1741
|
705 |
|
706 if (error_state) |
|
707 { |
|
708 if (error_state) |
2971
|
709 eval_error (); |
|
710 |
2086
|
711 return octave_value (); |
1741
|
712 } |
|
713 |
|
714 return retval; |
|
715 } |
|
716 |
|
717 void |
2971
|
718 tree_colon_expression::eval_error (const string& s) |
1741
|
719 { |
|
720 if (error_state > 0) |
2971
|
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 } |
1741
|
728 } |
|
729 |
|
730 void |
2124
|
731 tree_colon_expression::accept (tree_walker& tw) |
1741
|
732 { |
2124
|
733 tw.visit_colon_expression (*this); |
1741
|
734 } |
|
735 |
2971
|
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_variable_reference |
|
793 tree_index_expression::lvalue (void) |
|
794 { |
|
795 octave_variable_reference 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_variable_reference 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 |
2978
|
916 error ("element number %d undefined in return list", k); |
2971
|
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 |
2958
|
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 } |
|
997 |
1741
|
998 /* |
|
999 ;;; Local Variables: *** |
|
1000 ;;; mode: C++ *** |
|
1001 ;;; End: *** |
|
1002 */ |