Mercurial > octave

comparison src/pt-exp-base.cc @ 506:0f388340e607

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1994-07-09 06:10:34 by jwe]
author jwe
date Sat, 09 Jul 1994 06:10:34 +0000
parents be155b3d5a2f
children ef71e51a2280
comparison
equal deleted inserted replaced
505:f264c1454c2b 506:0f388340e607
106 106
107 /* 107 /*
108 * Make sure that all arguments have values. 108 * Make sure that all arguments have values.
109 */ 109 */
110 static int 110 static int
111 all_args_defined (const Octave_object& args, int nargs) 111 all_args_defined (const Octave_object& args)
112 { 112 {
113 while (--nargs > 0) 113 int nargin = args.length ();
114 { 114
115 if (args(nargs).is_undefined ()) 115 while (--nargin > 0)
116 {
117 if (args(nargin).is_undefined ())
116 return 0; 118 return 0;
117 } 119 }
118 return 1; 120 return 1;
119 } 121 }
120 122
121 /* 123 /*
122 * Are any of the arguments `:'? 124 * Are any of the arguments `:'?
123 */ 125 */
124 static int 126 static int
125 any_arg_is_magic_colon (const Octave_object& args, int nargs) 127 any_arg_is_magic_colon (const Octave_object& args)
126 { 128 {
127 while (--nargs > 0) 129 int nargin = args.length ();
128 { 130
129 if (args(nargs).const_type () == tree_constant_rep::magic_colon) 131 while (--nargin > 0)
132 {
133 if (args(nargin).const_type () == tree_constant_rep::magic_colon)
130 return 1; 134 return 1;
131 } 135 }
132 return 0; 136 return 0;
133 } 137 }
134 138
571 575
572 return retval; 576 return retval;
573 } 577 }
574 578
575 tree_constant 579 tree_constant
576 tree_fvc::assign (tree_constant& t, const Octave_object& args, int nargs) 580 tree_fvc::assign (tree_constant& t, const Octave_object& args)
577 { 581 {
578 panic_impossible (); 582 panic_impossible ();
579 return tree_constant (); 583 return tree_constant ();
580 } 584 }
581 585
657 } 661 }
658 else if (general_fcn != (General_fcn) NULL) 662 else if (general_fcn != (General_fcn) NULL)
659 { 663 {
660 Octave_object args (1); 664 Octave_object args (1);
661 args(0) = tree_constant (my_name); 665 args(0) = tree_constant (my_name);
662 Octave_object tmp = (*general_fcn) (args, 1, 1); 666 Octave_object tmp = (*general_fcn) (args, 1);
663 if (tmp.length () > 0) 667 if (tmp.length () > 0)
664 retval = tmp(0); 668 retval = tmp(0);
665 } 669 }
666 else // Assume mapper function 670 else // Assume mapper function
667 ::error ("%s: argument expected", my_name); 671 ::error ("%s: argument expected", my_name);
668 672
669 return retval; 673 return retval;
670 } 674 }
671 675
672 Octave_object 676 Octave_object
673 tree_builtin::eval (int print, int nargout, const Octave_object& args, 677 tree_builtin::eval (int print, int nargout, const Octave_object& args)
674 int nargin)
675 { 678 {
676 Octave_object retval; 679 Octave_object retval;
677 680
678 if (error_state) 681 if (error_state)
679 return retval; 682 return retval;
683
684 int nargin = args.length ();
680 685
681 if (text_fcn != (Text_fcn) NULL) 686 if (text_fcn != (Text_fcn) NULL)
682 { 687 {
683 // XXX FIXME XXX -- what if some arg is not a string? 688 // XXX FIXME XXX -- what if some arg is not a string?
684 689
695 delete [] argv[i]; 700 delete [] argv[i];
696 delete [] argv; 701 delete [] argv;
697 } 702 }
698 else if (general_fcn != (General_fcn) NULL) 703 else if (general_fcn != (General_fcn) NULL)
699 { 704 {
700 if (any_arg_is_magic_colon (args, nargin)) 705 if (any_arg_is_magic_colon (args))
701 ::error ("invalid use of colon in function argument list"); 706 ::error ("invalid use of colon in function argument list");
702 else 707 else
703 retval = (*general_fcn) (args, nargin, nargout); 708 retval = (*general_fcn) (args, nargout);
704 } 709 }
705 else 710 else
706 { 711 {
707 if (nargin > nargin_max) 712 if (nargin > nargin_max)
708 ::error ("%s: too many arguments", my_name); 713 ::error ("%s: too many arguments", my_name);
834 else 839 else
835 return tree_constant (); 840 return tree_constant ();
836 } 841 }
837 842
838 tree_constant 843 tree_constant
839 tree_identifier::assign (tree_constant& rhs, const Octave_object& args, 844 tree_identifier::assign (tree_constant& rhs, const Octave_object& args)
840 int nargs)
841 { 845 {
842 tree_constant retval; 846 tree_constant retval;
843 847
844 if (rhs.is_defined ()) 848 if (rhs.is_defined ())
845 { 849 {
857 } 861 }
858 862
859 if (sym->is_variable () && sym->is_defined ()) 863 if (sym->is_variable () && sym->is_defined ())
860 { 864 {
861 tree_fvc *tmp = sym->def (); 865 tree_fvc *tmp = sym->def ();
862 retval = tmp->assign (rhs, args, nargs); 866 retval = tmp->assign (rhs, args);
863 } 867 }
864 else 868 else
865 { 869 {
866 assert (! sym->is_defined ()); 870 assert (! sym->is_defined ());
867 871
871 ::error ("is only possible when resize_on_range_error is true"); 875 ::error ("is only possible when resize_on_range_error is true");
872 return retval; 876 return retval;
873 } 877 }
874 878
875 tree_constant *tmp = new tree_constant (); 879 tree_constant *tmp = new tree_constant ();
876 retval = tmp->assign (rhs, args, nargs); 880 retval = tmp->assign (rhs, args);
877 if (retval.is_defined ()) 881 if (retval.is_defined ())
878 sym->define (tmp); 882 sym->define (tmp);
879 } 883 }
880 } 884 }
881 885
1151 { 1155 {
1152 int nargout = maybe_do_ans_assign ? 0 : 1; 1156 int nargout = maybe_do_ans_assign ? 0 : 1;
1153 1157
1154 // int nargin = (ans->is_constant ()) ? 0 : 1; 1158 // int nargin = (ans->is_constant ()) ? 0 : 1;
1155 Octave_object tmp_args; 1159 Octave_object tmp_args;
1156 Octave_object tmp = ans->eval (0, nargout, tmp_args, 0); 1160 Octave_object tmp = ans->eval (0, nargout, tmp_args);
1157 1161
1158 if (tmp.length () > 0) 1162 if (tmp.length () > 0)
1159 retval = tmp(0); 1163 retval = tmp(0);
1160 } 1164 }
1161 } 1165 }
1215 } 1219 }
1216 return retval; 1220 return retval;
1217 } 1221 }
1218 1222
1219 Octave_object 1223 Octave_object
1220 tree_identifier::eval (int print, int nargout, const Octave_object& args, 1224 tree_identifier::eval (int print, int nargout, const Octave_object& args)
1221 int nargin)
1222 { 1225 {
1223 Octave_object retval; 1226 Octave_object retval;
1224 1227
1225 if (error_state) 1228 if (error_state)
1226 return retval; 1229 return retval;
1240 1243
1241 // Don't count the output arguments that we create automatically. 1244 // Don't count the output arguments that we create automatically.
1242 1245
1243 nargout = 0; 1246 nargout = 0;
1244 1247
1245 retval = ans->eval (0, nargout, args, nargin); 1248 retval = ans->eval (0, nargout, args);
1246 1249
1247 if (retval.length () > 0 && retval(0).is_defined ()) 1250 if (retval.length () > 0 && retval(0).is_defined ())
1248 { 1251 {
1249 symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0); 1252 symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0);
1250 1253
1260 1263
1261 delete ans_id; // XXX FIXME XXX 1264 delete ans_id; // XXX FIXME XXX
1262 } 1265 }
1263 } 1266 }
1264 else 1267 else
1265 retval = ans->eval (print, nargout, args, nargin); 1268 retval = ans->eval (print, nargout, args);
1266 } 1269 }
1267 } 1270 }
1268 1271
1269 return retval; 1272 return retval;
1270 } 1273 }
1443 1446
1444 if (error_state || cmd_list == NULL_TREE) 1447 if (error_state || cmd_list == NULL_TREE)
1445 return retval; 1448 return retval;
1446 1449
1447 Octave_object tmp_args; 1450 Octave_object tmp_args;
1448 Octave_object tmp = eval (print, 1, tmp_args, 0); 1451 Octave_object tmp = eval (print, 1, tmp_args);
1449 1452
1450 if (! error_state && tmp.length () > 0) 1453 if (! error_state && tmp.length () > 0)
1451 retval = tmp(0); 1454 retval = tmp(0);
1452 1455
1453 return retval; 1456 return retval;
1468 symbol_table *tmp = (symbol_table *) table; 1471 symbol_table *tmp = (symbol_table *) table;
1469 tmp->clear (); 1472 tmp->clear ();
1470 } 1473 }
1471 1474
1472 Octave_object 1475 Octave_object
1473 tree_function::eval (int print, int nargout, const Octave_object& args, 1476 tree_function::eval (int print, int nargout, const Octave_object& args)
1474 int nargin)
1475 { 1477 {
1476 Octave_object retval; 1478 Octave_object retval;
1477 1479
1478 if (error_state) 1480 if (error_state)
1479 return retval; 1481 return retval;
1480 1482
1481 if (cmd_list == NULL_TREE) 1483 if (cmd_list == NULL_TREE)
1482 return retval; 1484 return retval;
1483 1485
1486 int nargin = args.length ();
1487
1484 begin_unwind_frame ("func_eval"); 1488 begin_unwind_frame ("func_eval");
1485 1489
1486 unwind_protect_int (call_depth); 1490 unwind_protect_int (call_depth);
1487 call_depth++; 1491 call_depth++;
1488 1492
1514 unwind_protect_int (curr_arg_number); 1518 unwind_protect_int (curr_arg_number);
1515 1519
1516 if (param_list != (tree_parameter_list *) NULL 1520 if (param_list != (tree_parameter_list *) NULL
1517 && ! param_list->varargs_only ()) 1521 && ! param_list->varargs_only ())
1518 { 1522 {
1519 param_list->define_from_arg_vector (args, nargin); 1523 param_list->define_from_arg_vector (args);
1520 if (error_state) 1524 if (error_state)
1521 goto abort; 1525 goto abort;
1522 } 1526 }
1523 1527
1524 // The following code is in a separate scope to avoid warnings from 1528 // The following code is in a separate scope to avoid warnings from
1617 panic ("invalid evaluation of generic expression"); 1621 panic ("invalid evaluation of generic expression");
1618 return tree_constant (); 1622 return tree_constant ();
1619 } 1623 }
1620 1624
1621 Octave_object 1625 Octave_object
1622 tree_expression::eval (int print, int nargout, const Octave_object& args, 1626 tree_expression::eval (int print, int nargout, const Octave_object& args)
1623 int nargin)
1624 { 1627 {
1625 panic_impossible (); 1628 panic_impossible ();
1626 return Octave_object (); 1629 return Octave_object ();
1627 } 1630 }
1628 1631
2126 eval_error (); 2129 eval_error ();
2127 } 2130 }
2128 else 2131 else
2129 { 2132 {
2130 // Extract the arguments into a simple vector. 2133 // Extract the arguments into a simple vector.
2131 int nargs = 0; 2134 Octave_object args = index->convert_to_const_vector ();
2132 Octave_object args = index->convert_to_const_vector (nargs); 2135
2136 int nargin = args.length ();
2133 2137
2134 if (error_state) 2138 if (error_state)
2135 eval_error (); 2139 eval_error ();
2136 else if (nargs > 1) 2140 else if (nargin > 1)
2137 { 2141 {
2138 ans = lhs->assign (rhs_val, args, nargs); 2142 ans = lhs->assign (rhs_val, args);
2139 if (error_state) 2143 if (error_state)
2140 eval_error (); 2144 eval_error ();
2141 } 2145 }
2142 } 2146 }
2143 } 2147 }
2226 2230
2227 if (error_state) 2231 if (error_state)
2228 return retval; 2232 return retval;
2229 2233
2230 Octave_object tmp_args; 2234 Octave_object tmp_args;
2231 Octave_object result = eval (print, 1, tmp_args, 0); 2235 Octave_object result = eval (print, 1, tmp_args);
2232 2236
2233 if (result.length () > 0) 2237 if (result.length () > 0)
2234 retval = result(0); 2238 retval = result(0);
2235 2239
2236 return retval; 2240 return retval;
2237 } 2241 }
2238 2242
2239 Octave_object 2243 Octave_object
2240 tree_multi_assignment_expression::eval (int print, int nargout, 2244 tree_multi_assignment_expression::eval (int print, int nargout,
2241 const Octave_object& args, 2245 const Octave_object& args)
2242 int nargin)
2243 { 2246 {
2244 assert (etype == tree::multi_assignment); 2247 assert (etype == tree::multi_assignment);
2245 2248
2246 if (error_state || rhs == (tree_expression *) NULL) 2249 if (error_state || rhs == (tree_expression *) NULL)
2247 return Octave_object (); 2250 return Octave_object ();
2248 2251
2249 nargout = lhs->length (); 2252 nargout = lhs->length ();
2250 Octave_object tmp_args; 2253 Octave_object tmp_args;
2251 Octave_object results = rhs->eval (0, nargout, tmp_args, 0); 2254 Octave_object results = rhs->eval (0, nargout, tmp_args);
2252 2255
2253 if (error_state) 2256 if (error_state)
2254 eval_error (); 2257 eval_error ();
2255 2258
2256 int ma_line = line (); 2259 int ma_line = line ();
2565 eval_error (); 2568 eval_error ();
2566 } 2569 }
2567 else 2570 else
2568 { 2571 {
2569 // Extract the arguments into a simple vector. 2572 // Extract the arguments into a simple vector.
2570 int nargin = 0; 2573 Octave_object args = list->convert_to_const_vector ();
2571 Octave_object args = list->convert_to_const_vector (nargin); 2574 // Don't pass null arguments.
2575 int nargin = args.length ();
2576 if (error_state)
2577 eval_error ();
2578 else if (nargin > 1 && all_args_defined (args))
2579 {
2580 Octave_object tmp = id->eval (print, 1, args);
2581
2582 if (error_state)
2583 eval_error ();
2584
2585 if (tmp.length () > 0)
2586 retval = tmp(0);
2587 }
2588 }
2589 return retval;
2590 }
2591
2592 Octave_object
2593 tree_index_expression::eval (int print, int nargout, const Octave_object& args)
2594 {
2595 Octave_object retval;
2596
2597 if (error_state)
2598 return retval;
2599
2600 if (list == (tree_argument_list *) NULL)
2601 {
2602 Octave_object tmp_args;
2603 retval = id->eval (print, nargout, tmp_args);
2604 if (error_state)
2605 eval_error ();
2606 }
2607 else
2608 {
2609 // Extract the arguments into a simple vector.
2610 Octave_object args = list->convert_to_const_vector ();
2572 // Don't pass null arguments. 2611 // Don't pass null arguments.
2573 if (error_state) 2612 if (error_state)
2574 eval_error (); 2613 eval_error ();
2575 else if (nargin > 1 && all_args_defined (args, nargin)) 2614 else if (args.length () > 1 && all_args_defined (args))
2576 { 2615 {
2577 Octave_object tmp = id->eval (print, 1, args, nargin); 2616 retval = id->eval (print, nargout, args);
2578
2579 if (error_state)
2580 eval_error ();
2581
2582 if (tmp.length () > 0)
2583 retval = tmp(0);
2584 }
2585 }
2586 return retval;
2587 }
2588
2589 Octave_object
2590 tree_index_expression::eval (int print, int nargout,
2591 const Octave_object& args, int nargin)
2592 {
2593 Octave_object retval;
2594
2595 if (error_state)
2596 return retval;
2597
2598 if (list == (tree_argument_list *) NULL)
2599 {
2600 Octave_object tmp_args;
2601 retval = id->eval (print, nargout, tmp_args, 0);
2602 if (error_state)
2603 eval_error ();
2604 }
2605 else
2606 {
2607 // Extract the arguments into a simple vector.
2608 int nargin = 0;
2609 Octave_object args = list->convert_to_const_vector (nargin);
2610 // Don't pass null arguments.
2611 if (error_state)
2612 eval_error ();
2613 else if (nargin > 1 && all_args_defined (args, nargin))
2614 {
2615 retval = id->eval (print, nargout, args, nargin);
2616 if (error_state) 2617 if (error_state)
2617 eval_error (); 2618 eval_error ();
2618 } 2619 }
2619 } 2620 }
2620 return retval; 2621 return retval;
2715 /* 2716 /*
2716 * Convert a linked list of trees to a vector of pointers to trees, 2717 * Convert a linked list of trees to a vector of pointers to trees,
2717 * evaluating them along the way. 2718 * evaluating them along the way.
2718 */ 2719 */
2719 Octave_object 2720 Octave_object
2720 tree_argument_list::convert_to_const_vector (int& len) 2721 tree_argument_list::convert_to_const_vector (void)
2721 { 2722 {
2722 len = length () + 1; 2723 int len = length () + 1;
2723 2724
2724 Octave_object args (len); 2725 Octave_object args (len);
2725 2726
2726 // args[0] may eventually hold something useful, like the function 2727 // args[0] may eventually hold something useful, like the function
2727 // name. 2728 // name.
2860 { 2861 {
2861 return param->define (t); 2862 return param->define (t);
2862 } 2863 }
2863 2864
2864 void 2865 void
2865 tree_parameter_list::define_from_arg_vector (const Octave_object& args, 2866 tree_parameter_list::define_from_arg_vector (const Octave_object& args)
2866 int nargin)
2867 { 2867 {
2868 if (args.length () <= 0) 2868 if (args.length () <= 0)
2869 return; 2869 return;
2870
2871 int nargin = args.length ();
2870 2872
2871 int expected_nargin = length () + 1; 2873 int expected_nargin = length () + 1;
2872 2874
2873 tree_parameter_list *ptr = this; 2875 tree_parameter_list *ptr = this;
2874 2876