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	Wed Sep 21 15:24:26 1994 +0000
+++ b/src/parse.y	Wed Sep 21 16:00:10 1994 +0000
@@ -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	Wed Sep 21 15:24:26 1994 +0000
+++ b/src/pt-exp-base.cc	Wed Sep 21 16:00:10 1994 +0000
@@ -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	Wed Sep 21 15:24:26 1994 +0000
+++ b/src/pt-exp-base.h	Wed Sep 21 16:00:10 1994 +0000
@@ -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	Wed Sep 21 15:24:26 1994 +0000
+++ b/src/pt-misc.cc	Wed Sep 21 16:00:10 1994 +0000
@@ -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	Wed Sep 21 15:24:26 1994 +0000
+++ b/src/pt-misc.h	Wed Sep 21 16:00:10 1994 +0000
@@ -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