Mercurial > hg > octave-jordi
changeset 723:1c072f20b522
[project @ 1994-09-21 16:00:10 by jwe]
author | jwe |
---|---|
date | Wed, 21 Sep 1994 16:00:10 +0000 |
parents | c40cdd16121e |
children | 86d73993eee2 |
files | src/parse.y src/pt-exp-base.cc src/pt-exp-base.h src/pt-misc.cc src/pt-misc.h |
diffstat | 5 files changed, 135 insertions(+), 15 deletions(-) [+] |
line wrap: on
line diff
--- a/src/parse.y +++ b/src/parse.y @@ -235,7 +235,8 @@ %type <tree_index_expression_type> variable word_list_cmd %type <tree_colon_expression_type> colon_expr %type <tree_argument_list_type> arg_list word_list -%type <tree_parameter_list_type> param_list param_list1 func_def1a +%type <tree_parameter_list_type> param_list param_list1 +%type <tree_parameter_list_type> return_list return_list1 %type <tree_command_type> command func_def %type <tree_if_command_type> if_command %type <tree_if_clause_type> elseif_clause else_clause @@ -884,16 +885,42 @@ tpl->mark_as_formal_parameters (); $$ = $5->define_ret_list (tpl); } - | func_def1a ']' g_symtab '=' func_def2 + | return_list g_symtab '=' func_def2 { $1->mark_as_formal_parameters (); - $$ = $5->define_ret_list ($1); + $$ = $4->define_ret_list ($1); } ; -func_def1a : '[' safe local_symtab identifier - { $$ = new tree_parameter_list ($4); } - | func_def1a ',' identifier +return_list_x : '[' safe local_symtab + ; + +return_list : return_list_x ']' + { $$ = new tree_parameter_list (); } + | return_list_x ELLIPSIS ']' + { + tree_parameter_list *tmp = new tree_parameter_list (); + tmp->mark_varargs_only (); + $$ = tmp; + } + | return_list1 ']' + { $$ = $1; } + | return_list1 ',' ELLIPSIS ']' + { + $1->mark_varargs (); + $$ = $1; + } + ; + +return_list1 : return_list_x identifier + { $$ = new tree_parameter_list ($2); } + | return_list_x error + { + yyerror ("parse error"); + error ("invalid function return list"); + ABORT_PARSE; + } + | return_list1 ',' identifier { $1->append ($3); } ;
--- a/src/pt-exp-base.cc +++ b/src/pt-exp-base.cc @@ -480,11 +480,6 @@ { cm (put_row, put_col) = tmp.double_value (); } - else if (tmp.is_string () && all_strings && str_ptr) - { - memcpy (str_ptr, tmp.string_value (), nc); - str_ptr += nc; - } else if (tmp.is_real_matrix () || tmp.is_range ()) { cm.insert (tmp.matrix_value (), put_row, put_col); @@ -2053,6 +2048,10 @@ tree_function::define_ret_list (tree_parameter_list *t) { ret_list = t; + + if (ret_list && ret_list->takes_varargs ()) + vr_list = new tree_va_return_list; + return this; } @@ -2109,6 +2108,20 @@ return retval; } +int +tree_function::takes_var_return (void) const +{ + return (ret_list && ret_list->takes_varargs ()); +} + +void +tree_function::octave_vr_val (const tree_constant& val) +{ + assert (vr_list); + + vr_list->append (val); +} + void tree_function::stash_function_name (char *s) { @@ -2144,6 +2157,14 @@ } static void +delete_vr_list (void *list) +{ + tree_va_return_list *tmp = (tree_va_return_list *) list; + tmp->clear (); + delete tmp; +} + +static void clear_symbol_table (void *table) { symbol_table *tmp = (symbol_table *) table; @@ -2172,8 +2193,21 @@ { sym_tab->push_context (); add_unwind_protect (pop_symbol_table_context, (void *) sym_tab); + + if (vr_list) + { +// Push new vr_list. + unwind_protect_ptr (vr_list); + vr_list = new tree_va_return_list; + +// Clear and delete the new one before restoring the old one. + add_unwind_protect (delete_vr_list, (void *) vr_list); + } } + if (vr_list) + vr_list->clear (); + // Force symbols to be undefined again when this function exits. add_unwind_protect (clear_symbol_table, (void *) sym_tab); @@ -2228,7 +2262,7 @@ // Copy return values out. if (ret_list) - retval = ret_list->convert_to_const_vector (); + retval = ret_list->convert_to_const_vector (vr_list); else if (user_pref.return_last_computed_value) retval(0) = last_computed_value; } @@ -2247,7 +2281,7 @@ if (param_list->takes_varargs ()) return -1; else - return param_list->length () + 1; + return param_list->length (); } else return 1; @@ -2390,6 +2424,35 @@ return retval; } +DEFUN ("vr_val", Fvr_val, Svr_val, 1, 0, + "vr_val (X): append X to the list of optional return values for a +function that allows a variable number of return values") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (curr_function) + { + if (curr_function->takes_var_return ()) + curr_function->octave_vr_val (args(0)); + else + { + error ("vr_val only valid within function declared to produce"); + error ("a variable number of values"); + } + } + else + error ("vr_val only valid within function body"); + } + else + print_usage ("vr_val"); + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pt-exp-base.h +++ b/src/pt-exp-base.h @@ -42,6 +42,7 @@ class tree_argument_list; class tree_parameter_list; class tree_return_list; +class tree_va_return_list; class symbol_record; class symbol_table; @@ -729,6 +730,7 @@ num_named_args = 0; num_args_passed = 0; curr_va_arg_number = 0; + vr_list = 0; } tree_function (int l = -1, int c = -1) : tree_fvc (l, c) @@ -772,6 +774,10 @@ tree_constant octave_va_arg (void); + int takes_var_return (void) const; + + void octave_vr_val (const tree_constant& val); + void stash_function_name (char *s); char *function_name (void) @@ -801,6 +807,7 @@ Octave_object args_passed; int num_args_passed; int curr_va_arg_number; + tree_va_return_list *vr_list; }; #endif
--- a/src/pt-misc.cc +++ b/src/pt-misc.cc @@ -302,10 +302,13 @@ } Octave_object -tree_parameter_list::convert_to_const_vector (void) +tree_parameter_list::convert_to_const_vector (tree_va_return_list *vr_list) { int nout = length (); + if (vr_list) + nout += vr_list->length (); + Octave_object retval; retval.resize (nout); @@ -321,6 +324,15 @@ i++; } + if (vr_list) + { + for (p = vr_list->first (); p != 0; vr_list->next (p)) + { + retval(i) = vr_list->operator () (p); + i++; + } + } + return retval; }
--- a/src/pt-misc.h +++ b/src/pt-misc.h @@ -43,6 +43,7 @@ class tree_argument_list; class tree_parameter_list; class tree_return_list; +class tree_va_return_list; class tree_global; class tree_global_init_list; @@ -50,6 +51,7 @@ #include "tree-base.h" #include "tree-expr.h" +#include "tree-const.h" #include "tree-cmd.h" // A list of expressions and commands to be executed. @@ -189,7 +191,7 @@ int is_defined (void); - Octave_object convert_to_const_vector (void); + Octave_object convert_to_const_vector (tree_va_return_list *vr_list); void print_code (ostream& os); @@ -222,6 +224,15 @@ void print_code (ostream& os); }; +class +tree_va_return_list : public SLList<tree_constant> +{ +public: + tree_va_return_list (void) : SLList<tree_constant> () { } + + ~tree_va_return_list (void) { } +}; + // List of expressions that make up a global statement. class