changeset 4700:ca3a1d687bba

[project @ 2004-01-21 03:28:31 by jwe]
author jwe
date Wed, 21 Jan 2004 03:28:32 +0000
parents 5e2c68946f30
children 34a740dc31a6
files doc/interpreter/func.txi src/ChangeLog src/octave.cc src/ov-base.cc src/ov-base.h src/ov-usr-fcn.cc src/ov-usr-fcn.h src/ov.cc src/ov.h src/variables.cc src/variables.h
diffstat 11 files changed, 222 insertions(+), 36 deletions(-) [+]
line wrap: on
line diff
--- a/doc/interpreter/func.txi	Tue Jan 20 23:04:47 2004 +0000
+++ b/doc/interpreter/func.txi	Wed Jan 21 03:28:32 2004 +0000
@@ -220,12 +220,7 @@
 To avoid such problems and to provide useful messages, we check for both
 possibilities and issue our own error message.
 
-@defvr {Automatic Variable} nargin
-When a function is called, this local variable is automatically
-initialized to the number of arguments passed to the function.  At the
-top level, @code{nargin} holds the number of command line arguments that
-were passed to Octave.
-@end defvr
+@DOCSTRING(nargin)
 
 @DOCSTRING(silent_functions)
 
@@ -320,29 +315,7 @@
 along with a warning if the value of the built-in variable
 @code{warn_undefined_return_values} is nonzero.
 
-@defvr {Automatic Variable} nargout
-When a function is called, this local variable is automatically
-initialized to the number of arguments expected to be returned.  For
-example, 
-
-@example
-f ()
-@end example
-
-@noindent
-will result in @code{nargout} being set to 0 inside the function
-@code{f} and
-
-@example
-[s, t] = f ()
-@end example
-
-@noindent
-will result in @code{nargout} being set to 2 inside the function
-@code{f}.
-
-At the top level, @code{nargout} is undefined.
-@end defvr
+@DOCSTRING(nargout)
 
 @DOCSTRING(warn_undefined_return_values)
 
--- a/src/ChangeLog	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ChangeLog	Wed Jan 21 03:28:32 2004 +0000
@@ -1,5 +1,25 @@
 2004-01-20  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
+	* variables.cc (is_valid_function): If warn, also print error
+	message if arg is not a string.
+
+	* ov-usr-fcn.cc (Fnargin, Fnargout): New functions.
+
+	* octave.cc (intern_argv): Lookup __nargin__ instead of nargin.
+	* ov-usr-fcn.cc (octave_user_function::install_automatic_vars):
+	Lookup __nargin__ and __nargout__ instead of nargin and nargout.
+
+	* variables.h (at_top_level): Now extern.
+	(lookup_user_function): New function.
+	* variables.cc: Provide decls.
+
+	* ov.h, ov.cc (octave_value::user_function_value):
+	New virtual function.
+	* ov-base.h, ov-base.cc (octave_base_value::user_function_value):
+	Provide default version.
+	* ov-usr-fcn.h (octave_user_function::user_function_value):
+	New function.
+
 	* ov-re-mat.cc (complex_array_value): New function.
 	* ov-re-mat.h: Provide decl.
 
--- a/src/octave.cc	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/octave.cc	Wed Jan 21 03:28:32 2004 +0000
@@ -164,7 +164,7 @@
 static void
 intern_argv (int argc, char **argv)
 {
-  bind_builtin_variable ("nargin", argc-1, true, true, 0);
+  bind_builtin_variable ("__nargin__", argc-1, true, true, 0);
 
   Cell args;
 
--- a/src/ov-base.cc	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov-base.cc	Wed Jan 21 03:28:32 2004 +0000
@@ -502,6 +502,17 @@
   return retval;
 }
 
+octave_user_function *
+octave_base_value::user_function_value (bool silent)
+{
+  octave_user_function *retval = 0;
+
+  if (! silent)
+    gripe_wrong_type_arg ("octave_base_value::user_function_value()",
+			  type_name ());
+  return retval;
+}
+
 octave_fcn_handle *
 octave_base_value::fcn_handle_value (bool silent)
 {
--- a/src/ov-base.h	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov-base.h	Wed Jan 21 03:28:32 2004 +0000
@@ -234,6 +234,8 @@
 
   octave_function *function_value (bool silent = false);
 
+  octave_user_function *user_function_value (bool silent = false);
+
   octave_fcn_handle *fcn_handle_value (bool silent = false);
 
   octave_value_list list_value (void) const;
--- a/src/ov-usr-fcn.cc	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov-usr-fcn.cc	Wed Jan 21 03:28:32 2004 +0000
@@ -561,8 +561,8 @@
   if (sym_tab)
     {
       argn_sr = sym_tab->lookup ("argn", true);
-      nargin_sr = sym_tab->lookup ("nargin", true);
-      nargout_sr = sym_tab->lookup ("nargout", true);
+      nargin_sr = sym_tab->lookup ("__nargin__", true);
+      nargout_sr = sym_tab->lookup ("__nargout__", true);
 
       if (takes_varargs ())
 	varargin_sr = sym_tab->lookup ("varargin", true);
@@ -593,6 +593,133 @@
     }
 }
 
+DEFUN (nargin, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn {Built-in Function} {} nargin ()\n\
+@deftypefnx {Built-in Function} {} nargin (@var{fcn_name})\n\
+Within a function, return the number of arguments passed to the function.\n\
+At the top level, return the number of command line arguments passed to\n\
+Octave.  If called with the optional argument @var{fcn_name}, return the\n\
+maximum number of arguments the named function can accept, or -1 if the\n\
+function accepts a variable number of arguments.\n\
+@end deftypefn")
+{
+  octave_value retval;
+
+  int nargin = args.length ();
+
+  if (nargin == 1)
+    {
+      std::string fname = args(0).string_value ();
+
+      if (! error_state)
+	{
+	  octave_user_function *fcn = lookup_user_function (fname);
+
+	  if (fcn)
+	    {
+	      if (fcn->takes_varargs ())
+		retval = -1;
+	      else
+		{
+		  tree_parameter_list *param_list = fcn->parameter_list ();
+
+		  retval = param_list ? param_list->length () : 0;
+		}
+	    }
+	  else
+	    error ("nargin: invalid function");
+	}
+      else
+	error ("nargin: expecting string as first argument");
+    }
+  else if (nargin == 0)
+    {
+      symbol_record *sr = curr_sym_tab->lookup ("__nargin__");
+
+      retval = sr ? sr->def () : 0;
+    }
+  else
+    print_usage ("nargin");
+
+  return retval;
+}
+
+DEFUN (nargout, args, ,
+  "-*- texinfo -*-\n\
+@deftypefn {Built-in Function} {} nargout ()\n\
+@deftypefnx {Built-in Function} {} nargout (@var{fcn_name})\n\
+Within a function, return the number of values the caller expects to\n\
+receive.  If called with the optional argument @var{fcn_name}, return the\n\
+maximum number of values the named function can produce, or -1 if the\n\
+function can produce a variable number of values.\n\
+\n\
+For example,\n\
+\n\
+@example\n\
+f ()\n\
+@end example\n\
+\n\
+@noindent\n\
+will cause @code{nargout} to return 0 inside the function code{f} and\n\
+\n\
+@example\n\
+[s, t] = f ()\n\
+@end example\n\
+\n\
+@noindent\n\
+will cause @code{nargout} to return 2 inside the function\n\
+@code{f}.\n\
+\n\
+At the top level, @code{nargout} is undefined.\n\
+@end deftypefn")
+{
+  octave_value retval;
+
+  int nargin = args.length ();
+
+  if (nargin == 1)
+    {
+      std::string fname = args(0).string_value ();
+
+      if (! error_state)
+	{
+	  octave_user_function *fcn = lookup_user_function (fname);
+
+	  if (fcn)
+	    {
+	      if (fcn->takes_var_return ())
+		retval = -1;
+	      else
+		{
+		  tree_parameter_list *ret_list = fcn->return_list ();
+
+		  retval = ret_list ? ret_list->length () : 0;
+		}
+	    }
+	  else
+	    error ("nargout: invalid function");
+	}
+      else
+	error ("nargout: expecting string as first argument");
+    }
+  else if (nargin == 0)
+    {
+      if (! at_top_level ())
+	{
+	  symbol_record *sr = curr_sym_tab->lookup ("__nargout__");
+
+	  retval = sr ? sr->def () : 0;
+	}
+      else
+	error ("nargout: invalid call at top level");
+    }
+  else
+    print_usage ("nargout");
+
+  return retval;
+}
+
 DEFUNX ("va_arg", Fva_arg, args, ,
   "-*- texinfo -*-\n\
 @deftypefn {Built-in Function} {} va_arg ()\n\
--- a/src/ov-usr-fcn.h	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov-usr-fcn.h	Wed Jan 21 03:28:32 2004 +0000
@@ -63,6 +63,8 @@
 
   octave_function *function_value (bool = false) { return this; }
 
+  octave_user_function *user_function_value (bool = false) { return this; }
+
   octave_user_function *define_param_list (tree_parameter_list *t);
 
   octave_user_function *define_ret_list (tree_parameter_list *t);
--- a/src/ov.cc	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov.cc	Wed Jan 21 03:28:32 2004 +0000
@@ -955,6 +955,12 @@
   return rep->function_value (silent);
 }
 
+octave_user_function *
+octave_value::user_function_value (bool silent)
+{
+  return rep->user_function_value (silent);
+}
+
 octave_fcn_handle *
 octave_value::fcn_handle_value (bool silent)
 {
--- a/src/ov.h	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/ov.h	Wed Jan 21 03:28:32 2004 +0000
@@ -51,6 +51,7 @@
 class octave_stream;
 class octave_streamoff;
 class octave_function;
+class octave_user_function;
 class octave_fcn_handle;
 class octave_value_list;
 class octave_lvalue;
@@ -562,6 +563,8 @@
 
   virtual octave_function *function_value (bool silent = false);
 
+  virtual octave_user_function *user_function_value (bool silent = false);
+
   virtual octave_fcn_handle *fcn_handle_value (bool silent = false);
 
   virtual octave_value_list list_value (void) const;
--- a/src/variables.cc	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/variables.cc	Wed Jan 21 03:28:32 2004 +0000
@@ -76,7 +76,7 @@
 // Symbol table for functions and built-in symbols.
 symbol_table *fbi_sym_tab = 0;
 
-static inline bool
+bool
 at_top_level (void)
 {
   return (curr_sym_tab == top_level_sym_tab);
@@ -299,10 +299,14 @@
   std::string fcn_name;
 
   if (arg.is_string ())
-    fcn_name = arg.string_value ();
+    {
+      fcn_name = arg.string_value ();
 
-  if (! error_state)
-    ans = is_valid_function (fcn_name, warn_for, warn);
+      if (! error_state)
+	ans = is_valid_function (fcn_name, warn_for, warn);
+      else if (warn)
+	error ("%s: expecting function name as argument", warn_for.c_str ());
+    }
   else if (warn)
     error ("%s: expecting function name as argument", warn_for.c_str ());
 
@@ -840,6 +844,38 @@
   return retval;
 }
 
+octave_user_function *
+lookup_user_function (const std::string& nm)
+{
+  octave_user_function *retval = 0;
+
+  symbol_record *sr = 0;
+
+  if (curr_parent_function)
+    {
+      std::string parent = curr_parent_function->function_name ();
+
+      sr = fbi_sym_tab->lookup (parent + ":" + nm);
+    }
+
+  if (! sr || ! sr->is_user_function ())
+    {
+      sr = fbi_sym_tab->lookup (nm, true);
+
+      if (sr && ! sr->is_user_function ())
+	load_fcn_from_file (sr, false);
+    }
+
+  if (sr)
+    {
+      octave_value v = sr->def ();
+
+      retval = v.user_function_value (true);
+    }
+
+  return retval;
+}
+
 octave_value
 get_global_value (const std::string& nm)
 {
--- a/src/variables.h	Tue Jan 20 23:04:47 2004 +0000
+++ b/src/variables.h	Wed Jan 21 03:28:32 2004 +0000
@@ -24,6 +24,7 @@
 #define octave_variables_h 1
 
 class octave_function;
+class octave_user_function;
 class symbol_record;
 class symbol_table;
 
@@ -40,6 +41,8 @@
 #include "ov-builtin.h"
 #include "symtab.h"
 
+extern bool at_top_level (void);
+
 extern void initialize_symbol_tables (void);
 
 extern bool is_builtin_variable (const std::string&);
@@ -83,6 +86,9 @@
 extern octave_function *
 lookup_function (const std::string& nm);
 
+extern octave_user_function *
+lookup_user_function (const std::string& nm);
+
 extern octave_value get_global_value (const std::string& nm);
 
 extern void set_global_value (const std::string& nm, const octave_value& val);