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