1741
|
1 /* |
|
2 |
1827
|
3 Copyright (C) 1996 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" |
|
40 #include "pager.h" |
|
41 #include "pt-const.h" |
|
42 #include "pt-exp.h" |
|
43 #include "pt-fvc.h" |
|
44 #include "pt-misc.h" |
|
45 #include "pt-mvr.h" |
2124
|
46 #include "pt-walk.h" |
1741
|
47 #include "utils.h" |
|
48 |
|
49 // Nonzero means we're returning from a function. |
|
50 extern int returning; |
|
51 |
|
52 // Nonzero means we're breaking out of a loop or function body. |
|
53 extern int breaking; |
|
54 |
|
55 // Prefix expressions. |
|
56 |
|
57 tree_prefix_expression::~tree_prefix_expression (void) |
|
58 { |
|
59 delete id; |
|
60 } |
|
61 |
2086
|
62 octave_value |
1827
|
63 tree_prefix_expression::eval (bool print) |
1741
|
64 { |
2086
|
65 octave_value retval; |
1741
|
66 |
|
67 if (error_state) |
|
68 return retval; |
|
69 |
|
70 if (id) |
|
71 { |
|
72 id->bump_value (etype); |
|
73 if (error_state) |
|
74 eval_error (); |
|
75 else |
|
76 { |
|
77 retval = id->eval (print); |
|
78 if (error_state) |
|
79 { |
2086
|
80 retval = octave_value (); |
1741
|
81 if (error_state) |
|
82 eval_error (); |
|
83 } |
|
84 } |
|
85 } |
|
86 return retval; |
|
87 } |
|
88 |
|
89 char * |
|
90 tree_prefix_expression::oper (void) const |
|
91 { |
|
92 static char *op; |
|
93 switch (etype) |
|
94 { |
|
95 case tree_expression::increment: |
|
96 op = "++"; |
|
97 break; |
|
98 |
|
99 case tree_expression::decrement: |
|
100 op = "--"; |
|
101 break; |
|
102 |
|
103 default: |
|
104 op = "<unknown>"; |
|
105 break; |
|
106 } |
|
107 return op; |
|
108 } |
|
109 |
|
110 void |
|
111 tree_prefix_expression::eval_error (void) |
|
112 { |
|
113 if (error_state > 0) |
|
114 { |
|
115 char *op = oper (); |
|
116 |
|
117 ::error ("evaluating prefix operator `%s' near line %d, column %d", |
|
118 op, line (), column ()); |
|
119 } |
|
120 } |
|
121 |
|
122 void |
2124
|
123 tree_prefix_expression::accept (tree_walker& tw) |
1741
|
124 { |
2124
|
125 tw.visit_prefix_expression (*this); |
1741
|
126 } |
|
127 |
|
128 // Postfix expressions. |
|
129 |
|
130 tree_postfix_expression::~tree_postfix_expression (void) |
|
131 { |
|
132 delete id; |
|
133 } |
|
134 |
2086
|
135 octave_value |
1827
|
136 tree_postfix_expression::eval (bool print) |
1741
|
137 { |
2086
|
138 octave_value retval; |
1741
|
139 |
|
140 if (error_state) |
|
141 return retval; |
|
142 |
|
143 if (id) |
|
144 { |
|
145 retval = id->eval (print); |
|
146 id->bump_value (etype); |
|
147 if (error_state) |
|
148 { |
2086
|
149 retval = octave_value (); |
1741
|
150 if (error_state) |
|
151 eval_error (); |
|
152 } |
|
153 } |
|
154 return retval; |
|
155 } |
|
156 |
|
157 char * |
|
158 tree_postfix_expression::oper (void) const |
|
159 { |
|
160 static char *op; |
|
161 switch (etype) |
|
162 { |
|
163 case tree_expression::increment: |
|
164 op = "++"; |
|
165 break; |
|
166 |
|
167 case tree_expression::decrement: |
|
168 op = "--"; |
|
169 break; |
|
170 |
|
171 default: |
|
172 op = "<unknown>"; |
|
173 break; |
|
174 } |
|
175 return op; |
|
176 } |
|
177 |
|
178 void |
|
179 tree_postfix_expression::eval_error (void) |
|
180 { |
|
181 if (error_state > 0) |
|
182 { |
|
183 char *op = oper (); |
|
184 |
|
185 ::error ("evaluating postfix operator `%s' near line %d, column %d", |
|
186 op, line (), column ()); |
|
187 } |
|
188 } |
|
189 |
|
190 void |
2124
|
191 tree_postfix_expression::accept (tree_walker& tw) |
1741
|
192 { |
2124
|
193 tw.visit_postfix_expression (*this); |
1741
|
194 } |
|
195 |
|
196 // Unary expressions. |
|
197 |
2086
|
198 octave_value |
1827
|
199 tree_unary_expression::eval (bool /* print */) |
1741
|
200 { |
|
201 if (error_state) |
2086
|
202 return octave_value (); |
1741
|
203 |
2086
|
204 octave_value retval; |
1741
|
205 |
|
206 switch (etype) |
|
207 { |
|
208 case tree_expression::not: |
|
209 case tree_expression::uminus: |
|
210 case tree_expression::hermitian: |
|
211 case tree_expression::transpose: |
|
212 if (op) |
|
213 { |
2086
|
214 octave_value u = op->eval (false); |
1741
|
215 if (error_state) |
|
216 eval_error (); |
|
217 else if (u.is_defined ()) |
|
218 { |
|
219 retval = do_unary_op (u, etype); |
|
220 if (error_state) |
|
221 { |
2086
|
222 retval = octave_value (); |
1741
|
223 if (error_state) |
|
224 eval_error (); |
|
225 } |
|
226 } |
|
227 } |
|
228 break; |
|
229 |
|
230 default: |
|
231 ::error ("unary operator %d not implemented", etype); |
|
232 break; |
|
233 } |
|
234 |
|
235 return retval; |
|
236 } |
|
237 |
|
238 char * |
|
239 tree_unary_expression::oper (void) const |
|
240 { |
|
241 static char *op; |
|
242 switch (etype) |
|
243 { |
|
244 case tree_expression::not: |
|
245 op = "!"; |
|
246 break; |
|
247 |
|
248 case tree_expression::uminus: |
|
249 op = "-"; |
|
250 break; |
|
251 |
|
252 case tree_expression::hermitian: |
|
253 op = "'"; |
|
254 break; |
|
255 |
|
256 case tree_expression::transpose: |
|
257 op = ".'"; |
|
258 break; |
|
259 |
|
260 default: |
|
261 op = "<unknown>"; |
|
262 break; |
|
263 } |
|
264 return op; |
|
265 } |
|
266 |
|
267 void |
|
268 tree_unary_expression::eval_error (void) |
|
269 { |
|
270 if (error_state > 0) |
|
271 { |
|
272 char *op = oper (); |
|
273 |
|
274 ::error ("evaluating unary operator `%s' near line %d, column %d", |
|
275 op, line (), column ()); |
|
276 } |
|
277 } |
|
278 |
|
279 void |
2124
|
280 tree_unary_expression::accept (tree_walker& tw) |
1741
|
281 { |
2124
|
282 tw.visit_unary_expression (*this); |
1741
|
283 } |
|
284 |
|
285 // Binary expressions. |
|
286 |
2086
|
287 octave_value |
1827
|
288 tree_binary_expression::eval (bool /* print */) |
1741
|
289 { |
|
290 if (error_state) |
2086
|
291 return octave_value (); |
1741
|
292 |
2086
|
293 octave_value retval; |
1741
|
294 |
|
295 switch (etype) |
|
296 { |
|
297 case tree_expression::add: |
|
298 case tree_expression::subtract: |
|
299 case tree_expression::multiply: |
|
300 case tree_expression::el_mul: |
|
301 case tree_expression::divide: |
|
302 case tree_expression::el_div: |
|
303 case tree_expression::leftdiv: |
|
304 case tree_expression::el_leftdiv: |
|
305 case tree_expression::power: |
|
306 case tree_expression::elem_pow: |
|
307 case tree_expression::cmp_lt: |
|
308 case tree_expression::cmp_le: |
|
309 case tree_expression::cmp_eq: |
|
310 case tree_expression::cmp_ge: |
|
311 case tree_expression::cmp_gt: |
|
312 case tree_expression::cmp_ne: |
|
313 case tree_expression::and: |
|
314 case tree_expression::or: |
2124
|
315 if (op_lhs) |
1741
|
316 { |
2124
|
317 octave_value a = op_lhs->eval (false); |
1741
|
318 if (error_state) |
|
319 eval_error (); |
2124
|
320 else if (a.is_defined () && op_rhs) |
1741
|
321 { |
2124
|
322 octave_value b = op_rhs->eval (false); |
1741
|
323 if (error_state) |
|
324 eval_error (); |
|
325 else if (b.is_defined ()) |
|
326 { |
|
327 retval = do_binary_op (a, b, etype); |
|
328 if (error_state) |
|
329 { |
2086
|
330 retval = octave_value (); |
1741
|
331 if (error_state) |
|
332 eval_error (); |
|
333 } |
|
334 } |
|
335 } |
|
336 } |
|
337 break; |
|
338 |
|
339 case tree_expression::and_and: |
|
340 case tree_expression::or_or: |
|
341 { |
1827
|
342 bool result = false; |
2124
|
343 if (op_lhs) |
1741
|
344 { |
2124
|
345 octave_value a = op_lhs->eval (false); |
1741
|
346 if (error_state) |
|
347 { |
|
348 eval_error (); |
|
349 break; |
|
350 } |
|
351 |
1827
|
352 bool a_true = a.is_true (); |
1741
|
353 if (error_state) |
|
354 { |
|
355 eval_error (); |
|
356 break; |
|
357 } |
|
358 |
|
359 if (a_true) |
|
360 { |
|
361 if (etype == tree_expression::or_or) |
|
362 { |
1827
|
363 result = true; |
1741
|
364 goto done; |
|
365 } |
|
366 } |
|
367 else |
|
368 { |
|
369 if (etype == tree_expression::and_and) |
|
370 { |
1827
|
371 result = false; |
1741
|
372 goto done; |
|
373 } |
|
374 } |
|
375 |
2124
|
376 if (op_rhs) |
1741
|
377 { |
2124
|
378 octave_value b = op_rhs->eval (false); |
1741
|
379 if (error_state) |
|
380 { |
|
381 eval_error (); |
|
382 break; |
|
383 } |
|
384 |
|
385 result = b.is_true (); |
|
386 if (error_state) |
|
387 { |
|
388 eval_error (); |
|
389 break; |
|
390 } |
|
391 } |
|
392 } |
|
393 done: |
2086
|
394 retval = octave_value ((double) result); |
1741
|
395 } |
|
396 break; |
|
397 |
|
398 default: |
|
399 ::error ("binary operator %d not implemented", etype); |
|
400 break; |
|
401 } |
|
402 |
|
403 return retval; |
|
404 } |
|
405 |
|
406 char * |
|
407 tree_binary_expression::oper (void) const |
|
408 { |
|
409 static char *op; |
|
410 switch (etype) |
|
411 { |
|
412 case tree_expression::add: |
|
413 op = "+"; |
|
414 break; |
|
415 |
|
416 case tree_expression::subtract: |
|
417 op = "-"; |
|
418 break; |
|
419 |
|
420 case tree_expression::multiply: |
|
421 op = "*"; |
|
422 break; |
|
423 |
|
424 case tree_expression::el_mul: |
|
425 op = ".*"; |
|
426 break; |
|
427 |
|
428 case tree_expression::divide: |
|
429 op = "/"; |
|
430 break; |
|
431 |
|
432 case tree_expression::el_div: |
|
433 op = "./"; |
|
434 break; |
|
435 |
|
436 case tree_expression::leftdiv: |
|
437 op = "\\"; |
|
438 break; |
|
439 |
|
440 case tree_expression::el_leftdiv: |
|
441 op = ".\\"; |
|
442 break; |
|
443 |
|
444 case tree_expression::power: |
|
445 op = "^"; |
|
446 break; |
|
447 |
|
448 case tree_expression::elem_pow: |
|
449 op = ".^"; |
|
450 break; |
|
451 |
|
452 case tree_expression::cmp_lt: |
|
453 op = "<"; |
|
454 break; |
|
455 |
|
456 case tree_expression::cmp_le: |
|
457 op = "<="; |
|
458 break; |
|
459 |
|
460 case tree_expression::cmp_eq: |
|
461 op = "=="; |
|
462 break; |
|
463 |
|
464 case tree_expression::cmp_ge: |
|
465 op = ">="; |
|
466 break; |
|
467 |
|
468 case tree_expression::cmp_gt: |
|
469 op = ">"; |
|
470 break; |
|
471 |
|
472 case tree_expression::cmp_ne: |
|
473 op = "!="; |
|
474 break; |
|
475 |
|
476 case tree_expression::and_and: |
|
477 op = "&&"; |
|
478 break; |
|
479 |
|
480 case tree_expression::or_or: |
|
481 op = "||"; |
|
482 break; |
|
483 |
|
484 case tree_expression::and: |
|
485 op = "&"; |
|
486 break; |
|
487 |
|
488 case tree_expression::or: |
|
489 op = "|"; |
|
490 break; |
|
491 |
|
492 default: |
|
493 op = "<unknown>"; |
|
494 break; |
|
495 } |
|
496 return op; |
|
497 } |
|
498 |
|
499 void |
|
500 tree_binary_expression::eval_error (void) |
|
501 { |
|
502 if (error_state > 0) |
|
503 { |
|
504 char *op = oper (); |
|
505 |
|
506 ::error ("evaluating binary operator `%s' near line %d, column %d", |
|
507 op, line (), column ()); |
|
508 } |
|
509 } |
|
510 |
|
511 void |
2124
|
512 tree_binary_expression::accept (tree_walker& tw) |
1741
|
513 { |
2124
|
514 tw.visit_binary_expression (*this); |
1741
|
515 } |
|
516 |
|
517 // Simple assignment expressions. |
|
518 |
|
519 tree_simple_assignment_expression::tree_simple_assignment_expression |
1827
|
520 (tree_identifier *i, tree_expression *r, bool plhs, bool ans_assign, |
1741
|
521 int l, int c) |
|
522 : tree_expression (l, c) |
|
523 { |
|
524 init (plhs, ans_assign); |
|
525 lhs = new tree_indirect_ref (i); |
|
526 rhs = r; |
|
527 } |
|
528 |
|
529 tree_simple_assignment_expression::tree_simple_assignment_expression |
1827
|
530 (tree_index_expression *idx_expr, tree_expression *r, bool plhs, |
|
531 bool ans_assign, int l, int c) |
1741
|
532 : tree_expression (l, c) |
|
533 { |
|
534 init (plhs, ans_assign); |
|
535 lhs_idx_expr = idx_expr; // cache this -- we may need to delete it. |
|
536 lhs = idx_expr->ident (); |
|
537 index = idx_expr->arg_list (); |
|
538 rhs = r; |
|
539 } |
|
540 |
|
541 tree_simple_assignment_expression::~tree_simple_assignment_expression (void) |
|
542 { |
|
543 if (! preserve) |
|
544 { |
|
545 if (lhs_idx_expr) |
|
546 delete lhs_idx_expr; |
|
547 else |
|
548 delete lhs; |
|
549 } |
|
550 |
|
551 delete rhs; |
|
552 } |
|
553 |
1827
|
554 bool |
1741
|
555 tree_simple_assignment_expression::left_hand_side_is_identifier_only (void) |
|
556 { |
|
557 return lhs->is_identifier_only (); |
|
558 } |
|
559 |
|
560 tree_identifier * |
|
561 tree_simple_assignment_expression::left_hand_side_id (void) |
|
562 { |
|
563 return lhs->ident (); |
|
564 } |
|
565 |
2086
|
566 octave_value |
1827
|
567 tree_simple_assignment_expression::eval (bool print) |
1741
|
568 { |
|
569 assert (etype == tree_expression::assignment); |
|
570 |
2086
|
571 octave_value retval; |
1741
|
572 |
|
573 if (error_state) |
|
574 return retval; |
|
575 |
|
576 if (rhs) |
|
577 { |
2086
|
578 octave_value rhs_val = rhs->eval (false); |
1741
|
579 if (error_state) |
|
580 { |
|
581 eval_error (); |
|
582 } |
|
583 else if (rhs_val.is_undefined ()) |
|
584 { |
|
585 error ("value on right hand side of assignment is undefined"); |
|
586 eval_error (); |
|
587 } |
|
588 else if (! index) |
|
589 { |
|
590 retval = lhs->assign (rhs_val); |
|
591 if (error_state) |
|
592 eval_error (); |
|
593 } |
|
594 else |
|
595 { |
|
596 // Extract the arguments into a simple vector. |
|
597 |
2086
|
598 octave_value_list args = index->convert_to_const_vector (); |
1741
|
599 |
|
600 if (error_state) |
|
601 eval_error (); |
|
602 else |
|
603 { |
|
604 int nargin = args.length (); |
|
605 |
|
606 if (error_state) |
|
607 eval_error (); |
|
608 else if (nargin > 0) |
|
609 { |
|
610 retval = lhs->assign (rhs_val, args); |
|
611 if (error_state) |
|
612 eval_error (); |
|
613 } |
|
614 } |
|
615 } |
|
616 } |
|
617 |
|
618 if (! error_state && print && retval.is_defined ()) |
1755
|
619 retval.print_with_name (lhs->name ()); |
1741
|
620 |
|
621 return retval; |
|
622 } |
|
623 |
|
624 void |
|
625 tree_simple_assignment_expression::eval_error (void) |
|
626 { |
|
627 if (error_state > 0) |
|
628 { |
|
629 int l = line (); |
|
630 int c = column (); |
1827
|
631 |
1741
|
632 if (l != -1 && c != -1) |
|
633 ::error ("evaluating assignment expression near line %d, column %d", |
|
634 l, c); |
|
635 } |
|
636 } |
|
637 |
|
638 void |
2124
|
639 tree_simple_assignment_expression::accept (tree_walker& tw) |
1741
|
640 { |
2124
|
641 tw.visit_simple_assignment_expression (*this); |
1741
|
642 } |
|
643 |
|
644 // Colon expressions. |
|
645 |
1827
|
646 bool |
1741
|
647 tree_colon_expression::is_range_constant (void) const |
|
648 { |
2124
|
649 bool tmp = (op_base && op_base->is_constant () |
|
650 && op_limit && op_limit->is_constant ()); |
1741
|
651 |
2124
|
652 return op_increment ? (tmp && op_increment->is_constant ()) : tmp; |
1741
|
653 } |
|
654 |
|
655 tree_colon_expression * |
|
656 tree_colon_expression::chain (tree_expression *t) |
|
657 { |
|
658 tree_colon_expression *retval = 0; |
2124
|
659 if (! op_base || op_increment) |
1741
|
660 ::error ("invalid colon expression"); |
|
661 else |
|
662 { |
2124
|
663 // Stupid syntax: |
|
664 // |
|
665 // base : limit |
|
666 // base : increment : limit |
|
667 |
|
668 op_increment = op_limit; |
|
669 op_limit = t; |
1741
|
670 |
|
671 retval = this; |
|
672 } |
|
673 return retval; |
|
674 } |
|
675 |
2086
|
676 octave_value |
1827
|
677 tree_colon_expression::eval (bool /* print */) |
1741
|
678 { |
2086
|
679 octave_value retval; |
1741
|
680 |
2124
|
681 if (error_state || ! op_base || ! op_limit) |
1741
|
682 return retval; |
|
683 |
2124
|
684 octave_value tmp = op_base->eval (false); |
1741
|
685 |
|
686 if (tmp.is_undefined ()) |
|
687 { |
|
688 eval_error ("invalid null value in colon expression"); |
|
689 return retval; |
|
690 } |
|
691 |
|
692 double base = tmp.double_value (); |
|
693 |
|
694 if (error_state) |
|
695 { |
|
696 error ("colon expression elements must be scalars"); |
|
697 eval_error ("evaluating colon expression"); |
|
698 return retval; |
|
699 } |
|
700 |
2124
|
701 tmp = op_limit->eval (false); |
1741
|
702 |
|
703 if (tmp.is_undefined ()) |
|
704 { |
|
705 eval_error ("invalid null value in colon expression"); |
|
706 return retval; |
|
707 } |
|
708 |
|
709 double limit = tmp.double_value (); |
|
710 |
|
711 if (error_state) |
|
712 { |
|
713 error ("colon expression elements must be scalars"); |
|
714 eval_error ("evaluating colon expression"); |
|
715 return retval; |
|
716 } |
|
717 |
|
718 double inc = 1.0; |
2124
|
719 |
|
720 if (op_increment) |
1741
|
721 { |
2124
|
722 tmp = op_increment->eval (false); |
1741
|
723 |
|
724 if (tmp.is_undefined ()) |
|
725 { |
|
726 eval_error ("invalid null value in colon expression"); |
|
727 return retval; |
|
728 } |
|
729 |
|
730 inc = tmp.double_value (); |
|
731 |
|
732 if (error_state) |
|
733 { |
|
734 error ("colon expression elements must be scalars"); |
|
735 eval_error ("evaluating colon expression"); |
|
736 return retval; |
|
737 } |
|
738 } |
|
739 |
2086
|
740 retval = octave_value (base, limit, inc); |
1741
|
741 |
|
742 if (error_state) |
|
743 { |
|
744 if (error_state) |
|
745 eval_error ("evaluating colon expression"); |
2086
|
746 return octave_value (); |
1741
|
747 } |
|
748 |
|
749 return retval; |
|
750 } |
|
751 |
|
752 void |
|
753 tree_colon_expression::eval_error (const char *s) |
|
754 { |
|
755 if (error_state > 0) |
|
756 ::error ("%s near line %d column %d", s, line (), column ()); |
|
757 } |
|
758 |
|
759 void |
2124
|
760 tree_colon_expression::accept (tree_walker& tw) |
1741
|
761 { |
2124
|
762 tw.visit_colon_expression (*this); |
1741
|
763 } |
|
764 |
|
765 /* |
|
766 ;;; Local Variables: *** |
|
767 ;;; mode: C++ *** |
|
768 ;;; End: *** |
|
769 */ |