# HG changeset patch # User jwe # Date 863725379 0 # Node ID ebbc34ff7f66d9593fe016a8ad36d68834e5fcd4 # Parent ef3379196bcfeb4b5f830792f33cfb63a2b96391 [project @ 1997-05-15 19:36:16 by jwe] diff --git a/src/defun.cc b/src/defun.cc new file mode 100644 --- /dev/null +++ b/src/defun.cc @@ -0,0 +1,133 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "defun-int.h" +#include "ov.h" +#include "ov-builtin.h" +#include "ov-mapper.h" +#include "symtab.h" +#include "variables.h" + +// Install variables and functions in the symbol tables. + +void +install_builtin_mapper (void *mf_arg) +{ + octave_mapper *mf = static_cast (mf_arg); + + symbol_record *sym_rec = global_sym_tab->lookup (mf->name (), true); + + unsigned int t + = symbol_def::BUILTIN_FUNCTION | symbol_def::MAPPER_FUNCTION; + + sym_rec->unprotect (); + sym_rec->define (mf, t); + sym_rec->document (mf->doc_string ()); + sym_rec->make_eternal (); + sym_rec->protect (); +} + +void +install_builtin_function (void *f_arg, const string& name, + const string& doc, bool is_text_fcn) +{ + octave_builtin::fcn f = static_cast (f_arg); + + symbol_record *sym_rec = global_sym_tab->lookup (name, true); + + unsigned int t = symbol_def::BUILTIN_FUNCTION; + + if (is_text_fcn) + t |= symbol_def::TEXT_FUNCTION; + + sym_rec->unprotect (); + sym_rec->define (new octave_builtin (f, name, doc), t); + sym_rec->document (doc); + sym_rec->make_eternal (); + sym_rec->protect (); +} + +static void +install_builtin_variable_as_function (const string& name, + const octave_value& val, + bool protect, bool eternal, + const string& help) +{ + symbol_record *sym_rec = global_sym_tab->lookup (name, true); + sym_rec->unprotect (); + + string tmp_help = help.empty () ? sym_rec->help () : help; + + sym_rec->define_as_fcn (val); + + sym_rec->document (tmp_help); + + if (protect) + sym_rec->protect (); + + if (eternal) + sym_rec->make_eternal (); +} + +void +install_builtin_variable (const string& name, const octave_value& value, + bool install_as_function, bool protect, + bool eternal, void *sv_fcn_arg, + const string& help_string) +{ + symbol_record::sv_function sv_fcn + = static_cast (sv_fcn_arg); + + if (install_as_function) + install_builtin_variable_as_function (name, value, protect, + eternal, help_string); + else + bind_builtin_variable (name, value, protect, eternal, + sv_fcn, help_string); +} + +void +alias_builtin (const string& alias, const string& name) +{ + symbol_record *sr_name = global_sym_tab->lookup (name); + + if (! sr_name) + panic ("can't alias to undefined name!"); + + symbol_record *sr_alias = global_sym_tab->lookup (alias, true); + + if (sr_alias) + sr_alias->alias (sr_name); + else + panic ("can't find symbol record for builtin function `%s'", + alias.c_str ()); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-base.cc b/src/ov-base.cc --- a/src/ov-base.cc +++ b/src/ov-base.cc @@ -34,6 +34,7 @@ #include "gripes.h" #include "oct-map.h" +#include "oct-obj.h" #include "oct-var-ref.h" #include "ops.h" #include "ov-base.h" @@ -52,7 +53,15 @@ const string octave_base_value::t_name (""); octave_value -octave_base_value::do_index_op (const octave_value_list&) const +octave_base_value::do_index_op (const octave_value_list&) +{ + string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +octave_value_list +octave_base_value::do_index_op (int, const octave_value_list&) { string nm = type_name (); error ("can't perform indexing operations for %s type", nm.c_str ()); @@ -224,6 +233,17 @@ return retval; } +octave_function * +octave_base_value::function_value (bool silent) +{ + octave_function *retval = 0; + + if (! silent) + gripe_wrong_type_arg ("octave_base_value::function_value()", + type_name ()); + return retval; +} + octave_value_list octave_base_value::list_value (void) const { diff --git a/src/ov-base.h b/src/ov-base.h --- a/src/ov-base.h +++ b/src/ov-base.h @@ -70,7 +70,9 @@ octave_value *try_narrowing_conversion (void) { return static_cast (0); } - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); + + octave_value_list do_index_op (int nargout, const octave_value_list& idx); idx_vector index_vector (void) const; @@ -141,6 +143,10 @@ bool is_zero_by_zero (void) const { return (rows () == 0 && columns () == 0); } + bool is_constant (void) const { return false; } + + bool is_function (void) const { return false; } + double double_value (bool) const; double scalar_value (bool) const { return double_value (); } @@ -165,6 +171,8 @@ int stream_number (void) const; + octave_function *function_value (bool silent); + octave_value_list list_value (void) const; bool bool_value (void) const; diff --git a/src/ov-bool-mat.cc b/src/ov-bool-mat.cc --- a/src/ov-bool-mat.cc +++ b/src/ov-bool-mat.cc @@ -79,7 +79,7 @@ } octave_value -octave_bool_matrix::do_index_op (const octave_value_list& idx) const +octave_bool_matrix::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-bool-mat.h b/src/ov-bool-mat.h --- a/src/ov-bool-mat.h +++ b/src/ov-bool-mat.h @@ -75,7 +75,7 @@ octave_value *try_narrowing_conversion (void); - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); void assign (const octave_value_list& idx, const boolMatrix& rhs); @@ -86,6 +86,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_bool_matrix (void) const { return true; } octave_value all (void) const { return matrix.all (); } diff --git a/src/ov-bool.cc b/src/ov-bool.cc --- a/src/ov-bool.cc +++ b/src/ov-bool.cc @@ -76,7 +76,7 @@ } octave_value -octave_bool::do_index_op (const octave_value_list& idx) const +octave_bool::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-bool.h b/src/ov-bool.h --- a/src/ov-bool.h +++ b/src/ov-bool.h @@ -74,7 +74,7 @@ type_conv_fcn numeric_conversion_function (void) const; - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); idx_vector index_vector (void) const { return idx_vector (scalar); } @@ -82,6 +82,9 @@ int columns (void) const { return 1; } bool is_defined (void) const { return true; } + + bool is_constant (void) const { return true; } + bool is_real_scalar (void) const { return true; } octave_value all (void) const { return scalar; } diff --git a/src/ov-builtin.cc b/src/ov-builtin.cc new file mode 100644 --- /dev/null +++ b/src/ov-builtin.cc @@ -0,0 +1,79 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if defined (__GNUG__) +#pragma implementation +#endif + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "oct-obj.h" +#include "ov-builtin.h" +#include "ov.h" + +octave_allocator +octave_builtin::allocator (sizeof (octave_builtin)); + +int +octave_builtin::t_id (-1); + +const string +octave_builtin::t_name ("built-in function"); + +// Are any of the arguments `:'? + +static bool +any_arg_is_magic_colon (const octave_value_list& args) +{ + int nargin = args.length (); + + for (int i = 0; i < nargin; i++) + if (args(i).is_magic_colon ()) + return true; + + return false; +} + +octave_value_list +octave_builtin::do_index_op (int nargout, const octave_value_list& args) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (any_arg_is_magic_colon (args)) + ::error ("invalid use of colon in function argument list"); + else + retval = (*f) (args, nargout); + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-builtin.h b/src/ov-builtin.h new file mode 100644 --- /dev/null +++ b/src/ov-builtin.h @@ -0,0 +1,97 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if !defined (octave_builtin_h) +#define octave_builtin_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include + +#include "ov-fcn.h" +#include "ov-typeinfo.h" + +class octave_value; +class octave_value_list; + +// Builtin functions. + +class +octave_builtin : public octave_function +{ +public: + + typedef octave_value_list (*fcn) (const octave_value_list&, int); + + octave_builtin (fcn ff, const string& nm = string (), + const string& ds = string ()) + : octave_function (nm, ds), f (ff) { } + + ~octave_builtin (void) { } + + void *operator new (size_t size) + { return allocator.alloc (size); } + + void operator delete (void *p, size_t size) + { allocator.free (p, size); } + + octave_function *function_value (bool) { return this; } + + octave_value_list do_index_op (int nargout, const octave_value_list& args); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + octave_builtin (void); + + octave_builtin (const octave_builtin& m); + + // A pointer to the actual function. + fcn f; + + // For custom memory management. + static octave_allocator allocator; + + // Type id of list objects, set by register_type(). + static int t_id; + + // Type name of list objects, defined in ov-list.cc. + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-ch-mat.h b/src/ov-ch-mat.h --- a/src/ov-ch-mat.h +++ b/src/ov-ch-mat.h @@ -84,6 +84,8 @@ int rows (void) const { return matrix.rows (); } int columns (void) const { return matrix.columns (); } + bool is_constant (void) const { return true; } + bool is_defined (void) const { return true; } bool is_char_matrix (void) const { return true; } diff --git a/src/ov-colon.h b/src/ov-colon.h --- a/src/ov-colon.h +++ b/src/ov-colon.h @@ -62,6 +62,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_magic_colon (void) const { return true; } bool valid_as_scalar_index (void) const { return true; } diff --git a/src/ov-complex.cc b/src/ov-complex.cc --- a/src/ov-complex.cc +++ b/src/ov-complex.cc @@ -73,7 +73,7 @@ } octave_value -octave_complex::do_index_op (const octave_value_list& idx) const +octave_complex::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-complex.h b/src/ov-complex.h --- a/src/ov-complex.h +++ b/src/ov-complex.h @@ -74,13 +74,15 @@ octave_value *try_narrowing_conversion (void); - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); int rows (void) const { return 1; } int columns (void) const { return 1; } bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_complex_scalar (void) const { return true; } octave_value all (void) const { return (scalar != 0.0); } diff --git a/src/ov-cx-mat.cc b/src/ov-cx-mat.cc --- a/src/ov-cx-mat.cc +++ b/src/ov-cx-mat.cc @@ -89,7 +89,7 @@ } octave_value -octave_complex_matrix::do_index_op (const octave_value_list& idx) const +octave_complex_matrix::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-cx-mat.h b/src/ov-cx-mat.h --- a/src/ov-cx-mat.h +++ b/src/ov-cx-mat.h @@ -81,7 +81,7 @@ octave_value *try_narrowing_conversion (void); - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); void assign (const octave_value_list& idx, const ComplexMatrix& rhs); @@ -92,6 +92,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_complex_matrix (void) const { return true; } octave_value all (void) const { return matrix.all (); } diff --git a/src/ov-fcn.cc b/src/ov-fcn.cc new file mode 100644 --- /dev/null +++ b/src/ov-fcn.cc @@ -0,0 +1,47 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if defined (__GNUG__) +#pragma implementation +#endif + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "ov-fcn.h" + +octave_allocator +octave_function::allocator (sizeof (octave_function)); + +octave_function * +octave_function::clone (void) +{ + panic_impossible (); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-fcn.h b/src/ov-fcn.h new file mode 100644 --- /dev/null +++ b/src/ov-fcn.h @@ -0,0 +1,99 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if !defined (octave_function_h) +#define octave_function_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include + +#include + +#include "oct-alloc.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +// Functions. + +class +octave_function : public octave_base_value +{ +public: + + octave_function (const octave_function& f) + : octave_base_value (), my_name (f.my_name), doc (f.doc) { } + + ~octave_function (void) { } + + // This should only be called for derived types. + + octave_function *clone (void); + + void *operator new (size_t size) + { return allocator.alloc (size); } + + void operator delete (void *p, size_t size) + { allocator.free (p, size); } + + bool is_defined (void) const { return true; } + + bool is_function (void) const { return true; } + + virtual bool is_system_fcn_file (void) { return false; } + + virtual string fcn_file_name (void) const { return string (); } + + virtual time_t time_parsed (void) const { return 0; } + + string name (void) const { return my_name; } + + string doc_string (void) const { return doc; } + +protected: + + octave_function (const string& nm, const string& ds) + : my_name (nm), doc (ds) { } + +private: + + octave_function (void); + + // The name of this function. + string my_name; + + // The help text for this function. + string doc; + + // For custom memory management. + static octave_allocator allocator; +}; + +#endif + +/* +;; Local Variables: *** +;; mode: C++ *** +;; End: *** +*/ diff --git a/src/ov-list.cc b/src/ov-list.cc --- a/src/ov-list.cc +++ b/src/ov-list.cc @@ -49,7 +49,7 @@ octave_list::t_name ("list"); octave_value -octave_list::do_index_op (const octave_value_list& idx) const +octave_list::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-list.h b/src/ov-list.h --- a/src/ov-list.h +++ b/src/ov-list.h @@ -70,10 +70,12 @@ void operator delete (void *p, size_t size) { allocator.free (p, size); } - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_list (void) const { return true; } octave_value_list list_value (void) const { return lst; } diff --git a/src/ov-mapper.cc b/src/ov-mapper.cc new file mode 100644 --- /dev/null +++ b/src/ov-mapper.cc @@ -0,0 +1,257 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if defined (__GNUG__) +#pragma implementation +#endif + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "error.h" +#include "gripes.h" +#include "oct-obj.h" +#include "ov-mapper.h" +#include "ov.h" + +octave_allocator +octave_mapper::allocator (sizeof (octave_mapper)); + +int +octave_mapper::t_id (-1); + +const string +octave_mapper::t_name ("built-in mapper function"); + +static bool +any_element_less_than (const Matrix& a, double val) +{ + int nr = a.rows (); + int nc = a.columns (); + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + if (a (i, j) < val) + return true; + + return false; +} + +static bool +any_element_greater_than (const Matrix& a, double val) +{ + int nr = a.rows (); + int nc = a.columns (); + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + if (a (i, j) > val) + return true; + + return false; +} + +octave_value +octave_mapper::apply (const octave_value& arg) const +{ + octave_value retval; + + if (ch_map_fcn) + { + // XXX FIXME XXX -- this could be done in a better way... + + octave_value tmp = arg.convert_to_str (); + + if (! error_state) + { + charMatrix chm = tmp.char_matrix_value (); + + if (! error_state) + { + int nr = chm.rows (); + int nc = chm.cols (); + + switch (flag) + { + case 0: + { + Matrix result (nr, nc); + + // islapha and friends can return any nonzero value + // to mean true, but we want to return 1 or 0 only. + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result (i, j) = ch_map_fcn (chm (i, j)) ? 1 : 0; + + retval = result; + } + break; + + case 1: + { + Matrix result (nr, nc); + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result (i, j) = ch_map_fcn (chm (i, j)); + + retval = result; + } + break; + + case 2: + { + charMatrix result (nr, nc); + + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + result (i, j) = ch_map_fcn (chm (i, j)); + + retval = octave_value (result, true); + } + break; + + default: + panic_impossible (); + break; + } + } + } + } + else + { + if (arg.is_real_type ()) + { + if (arg.is_scalar_type ()) + { + double d = arg.double_value (); + + if (flag && (d < lower_limit || d > upper_limit)) + { + if (c_c_map_fcn) + retval = c_c_map_fcn (Complex (d)); + else + error ("%s: unable to handle real arguments", + name().c_str ()); + } + else if (d_d_map_fcn) + retval = d_d_map_fcn (d); + else + error ("%s: unable to handle real arguments", + name().c_str ()); + } + else + { + Matrix m = arg.matrix_value (); + + if (error_state) + return retval; + + if (flag + && (any_element_less_than (m, lower_limit) + || any_element_greater_than (m, upper_limit))) + { + if (c_c_map_fcn) + { + ComplexMatrix cm (m); + retval = cm.map (c_c_map_fcn); + } + else + error ("%s: unable to handle real arguments", + name().c_str ()); + } + else if (d_d_map_fcn) + retval = m.map (d_d_map_fcn); + else + error ("%s: unable to handle real arguments", + name().c_str ()); + } + } + else if (arg.is_complex_type ()) + { + if (arg.is_scalar_type ()) + { + Complex c = arg.complex_value (); + + if (d_c_map_fcn) + retval = d_c_map_fcn (c); + else if (c_c_map_fcn) + retval = c_c_map_fcn (c); + else + error ("%s: unable to handle complex arguments", + name().c_str ()); + } + else + { + ComplexMatrix cm = arg.complex_matrix_value (); + + if (error_state) + return retval; + + if (d_c_map_fcn) + retval = cm.map (d_c_map_fcn); + else if (c_c_map_fcn) + retval = cm.map (c_c_map_fcn); + else + error ("%s: unable to handle complex arguments", + name().c_str ()); + } + } + else + gripe_wrong_type_arg ("mapper", arg); + } + + return retval; +} + +octave_value_list +octave_mapper::do_index_op (int, const octave_value_list& args) +{ + octave_value retval; + + if (error_state) + return retval; + + int nargin = args.length (); + + if (nargin > 1) + ::error ("%s: too many arguments", name().c_str ()); + else if (nargin < 1) + ::error ("%s: too few arguments", name().c_str ()); + else + { + if (args(0).is_defined ()) + retval = apply (args(0)); + else + ::error ("%s: argument undefined", name().c_str ()); + } + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-mapper.h b/src/ov-mapper.h new file mode 100644 --- /dev/null +++ b/src/ov-mapper.h @@ -0,0 +1,129 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if !defined (octave_mapper_h) +#define octave_mapper_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include + +#include "ov-fcn.h" +#include "ov-typeinfo.h" + +class octave_value; +class octave_value_list; + +// Builtin mapper functions. + +class +octave_mapper : public octave_function +{ +public: + + typedef int (*ch_mapper) (int); + typedef double (*d_d_mapper) (double); + typedef double (*d_c_mapper) (const Complex&); + typedef Complex (*c_c_mapper) (const Complex&); + + octave_mapper (ch_mapper ch, d_d_mapper dd, d_c_mapper dc, + c_c_mapper cc, double ll, double ul, int f, + const string& nm = string (), + const string& ds = string ()) + : octave_function (nm, ds), ch_map_fcn (ch), d_d_map_fcn (dd), + d_c_map_fcn (dc), c_c_map_fcn (cc), + lower_limit (ll), upper_limit (ul), flag (f) { } + + ~octave_mapper (void) { } + + void *operator new (size_t size) + { return allocator.alloc (size); } + + void operator delete (void *p, size_t size) + { allocator.free (p, size); } + + octave_function *function_value (bool) { return this; } + + octave_value_list do_index_op (int nargout, const octave_value_list& args); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + octave_mapper (void); + + octave_mapper (const octave_mapper& m); + + octave_value apply (const octave_value& arg) const; + + // ch_map_fcn is a kluge. + + ch_mapper ch_map_fcn; + d_d_mapper d_d_map_fcn; + d_c_mapper d_c_map_fcn; + c_c_mapper c_c_map_fcn; + + // If flag is nonzero and we are not calling ch_map_fcn, lower_limit + // and upper_limit specify the range of values for which a real arg + // returns a real value. Outside that range, we have to convert args + // to complex, and call the complex valued function. + + double lower_limit; + double upper_limit; + + // For ch_map_fcn, flag has the following meanings: + // + // 0 => this function returns a matrix of ones and zeros + // 1 => this function returns a numeric matrix (any values) + // 2 => this function returns a string array + // + // For other mappers, nonzero means that this function can return a + // complex value for some real arguments. + + int flag; + + // For custom memory management. + static octave_allocator allocator; + + // Type id of list objects, set by register_type(). + static int t_id; + + // Type name of list objects, defined in ov-list.cc. + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-range.cc b/src/ov-range.cc --- a/src/ov-range.cc +++ b/src/ov-range.cc @@ -86,7 +86,7 @@ } octave_value -octave_range::do_index_op (const octave_value_list& idx) const +octave_range::do_index_op (const octave_value_list& idx) { // XXX FIXME XXX -- this doesn't solve the problem of // diff --git a/src/ov-range.h b/src/ov-range.h --- a/src/ov-range.h +++ b/src/ov-range.h @@ -91,7 +91,7 @@ octave_value *try_narrowing_conversion (void); - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); idx_vector index_vector (void) const { return idx_vector (range); } @@ -100,6 +100,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_range (void) const { return true; } // XXX DO ME XXX diff --git a/src/ov-re-mat.cc b/src/ov-re-mat.cc --- a/src/ov-re-mat.cc +++ b/src/ov-re-mat.cc @@ -77,7 +77,7 @@ } octave_value -octave_matrix::do_index_op (const octave_value_list& idx) const +octave_matrix::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-re-mat.h b/src/ov-re-mat.h --- a/src/ov-re-mat.h +++ b/src/ov-re-mat.h @@ -81,7 +81,7 @@ octave_value *try_narrowing_conversion (void); - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); void assign (const octave_value_list& idx, const Matrix& rhs); @@ -108,6 +108,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return true; } + bool is_real_matrix (void) const { return true; } octave_value all (void) const { return matrix.all (); } diff --git a/src/ov-scalar.cc b/src/ov-scalar.cc --- a/src/ov-scalar.cc +++ b/src/ov-scalar.cc @@ -62,7 +62,7 @@ } octave_value -octave_scalar::do_index_op (const octave_value_list& idx) const +octave_scalar::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-scalar.h b/src/ov-scalar.h --- a/src/ov-scalar.h +++ b/src/ov-scalar.h @@ -73,14 +73,17 @@ void operator delete (void *p, size_t size) { allocator.free (p, size); } - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); idx_vector index_vector (void) const { return idx_vector (scalar); } int rows (void) const { return 1; } int columns (void) const { return 1; } + bool is_constant (void) const { return true; } + bool is_defined (void) const { return true; } + bool is_real_scalar (void) const { return true; } octave_value all (void) const { return (scalar != 0.0); } diff --git a/src/ov-str-mat.cc b/src/ov-str-mat.cc --- a/src/ov-str-mat.cc +++ b/src/ov-str-mat.cc @@ -61,7 +61,7 @@ } octave_value -octave_char_matrix_str::do_index_op (const octave_value_list& idx) const +octave_char_matrix_str::do_index_op (const octave_value_list& idx) { octave_value retval; diff --git a/src/ov-str-mat.h b/src/ov-str-mat.h --- a/src/ov-str-mat.h +++ b/src/ov-str-mat.h @@ -80,7 +80,7 @@ type_conv_fcn numeric_conversion_function (void) const; - octave_value do_index_op (const octave_value_list& idx) const; + octave_value do_index_op (const octave_value_list& idx); void assign (const octave_value_list& idx, const charMatrix& rhs); diff --git a/src/ov-struct.h b/src/ov-struct.h --- a/src/ov-struct.h +++ b/src/ov-struct.h @@ -84,6 +84,8 @@ bool is_defined (void) const { return true; } + bool is_constant (void) const { return false; } + bool is_map (void) const { return true; } Octave_map map_value (void) const { return map; } diff --git a/src/ov-usr-fcn.cc b/src/ov-usr-fcn.cc new file mode 100644 --- /dev/null +++ b/src/ov-usr-fcn.cc @@ -0,0 +1,563 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if defined (__GNUG__) +#pragma implementation +#endif + +#ifdef HAVE_CONFIG_H +#include +#endif + +#include "str-vec.h" + +#include +#include "defun.h" +#include "error.h" +#include "help.h" +#include "input.h" +#include "oct-obj.h" +#include "ov-usr-fcn.h" +#include "ov.h" +#include "pager.h" +#include "pt-misc.h" +#include "pt-pr-code.h" +#include "pt-walk.h" +#include "symtab.h" +#include "toplev.h" +#include "unwind-prot.h" +#include "utils.h" +#include "variables.h" + +// If TRUE, variables returned from functions have default values even +// if they are not explicitly initialized. +static bool Vdefine_all_return_values; + +// If TRUE, the last computed value is returned from functions that +// don't actually define any return variables. +static bool Vreturn_last_computed_value; + +// Nonzero means we're breaking out of a loop or function body. +extern int breaking; + +// Nonzero means we're returning from a function. +extern int returning; + +// User defined functions. + +octave_allocator +octave_user_function::allocator (sizeof (octave_user_function)); + +int +octave_user_function::t_id (-1); + +const string +octave_user_function::t_name ("user-defined function"); + +// Ugh. This really needs to be simplified (code/data? +// extrinsic/intrinsic state?). + +octave_user_function::octave_user_function + (tree_parameter_list *pl, tree_parameter_list *rl, + tree_statement_list *cl, symbol_table *st) + : octave_function (string (), string ()), + param_list (pl), ret_list (rl), cmd_list (cl), + sym_tab (st), file_name (), fcn_name (), t_parsed (0), + system_fcn_file (false), call_depth (0), num_named_args (0), + args_passed (), num_args_passed (0), curr_va_arg_number (0), + vr_list (0), symtab_entry (0), argn_sr (0), nargin_sr (0), + nargout_sr (0) +{ + install_automatic_vars (); + + if (param_list) + { + num_named_args = param_list->length (); + curr_va_arg_number = num_named_args; + } +} + +octave_user_function::~octave_user_function (void) +{ + delete param_list; + delete ret_list; + delete sym_tab; + delete cmd_list; + delete vr_list; +} + +octave_user_function * +octave_user_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; +} + +void +octave_user_function::stash_fcn_file_name (void) +{ + if (fcn_name.empty ()) + file_name = ""; + else + file_name = fcn_file_in_path (fcn_name); +} + +void +octave_user_function::mark_as_system_fcn_file (void) +{ + if (! file_name.empty ()) + { + // We really should stash the whole path to the file we found, + // when we looked it up, to avoid possible race conditions... + // XXX FIXME XXX + // + // We probably also don't need to get the library directory + // every time, but since this function is only called when the + // function file is parsed, it probably doesn't matter that + // much. + + string ff_name = fcn_file_in_path (file_name); + + if (Vfcn_file_dir.compare (ff_name, 0, Vfcn_file_dir.length ()) == 0) + system_fcn_file = 1; + } + else + system_fcn_file = 0; +} + +bool +octave_user_function::takes_varargs (void) const +{ + return (param_list && param_list->takes_varargs ()); +} + +octave_value +octave_user_function::octave_va_arg (void) +{ + octave_value retval; + + if (curr_va_arg_number < num_args_passed) + retval = args_passed (curr_va_arg_number++); + else + ::error ("va_arg: error getting arg number %d -- only %d provided", + curr_va_arg_number + 1, num_args_passed); + + return retval; +} + +octave_value_list +octave_user_function::octave_all_va_args (void) +{ + octave_value_list retval; + + retval.resize (num_args_passed - num_named_args); + + int k = 0; + for (int i = num_named_args; i < num_args_passed; i++) + retval(k++) = args_passed(i); + + return retval; +} + +bool +octave_user_function::takes_var_return (void) const +{ + return (ret_list && ret_list->takes_varargs ()); +} + +void +octave_user_function::octave_vr_val (const octave_value& val) +{ + assert (vr_list); + + vr_list->append (val); +} + +void +octave_user_function::stash_function_name (const string& s) +{ + fcn_name = s; +} + +// For unwind protect. + +static void +pop_symbol_table_context (void *table) +{ + symbol_table *tmp = static_cast (table); + tmp->pop_context (); +} + +static void +delete_vr_list (void *list) +{ + tree_va_return_list *tmp = static_cast (list); + tmp->clear (); + delete tmp; +} + +static void +clear_symbol_table (void *table) +{ + symbol_table *tmp = static_cast (table); + tmp->clear (); +} + +static void +unprotect_function (void *sr_arg) +{ + symbol_record *sr = static_cast (sr_arg); + sr->unprotect (); +} + +octave_value_list +octave_user_function::do_index_op (int nargout, const octave_value_list& args) +{ + octave_value_list retval; + + if (error_state) + return retval; + + if (! cmd_list) + return retval; + + int nargin = args.length (); + + begin_unwind_frame ("func_eval"); + + unwind_protect_int (call_depth); + call_depth++; + + if (symtab_entry && ! symtab_entry->is_read_only ()) + { + symtab_entry->protect (); + add_unwind_protect (unprotect_function, symtab_entry); + } + + if (call_depth > 1) + { + sym_tab->push_context (); + add_unwind_protect (pop_symbol_table_context, 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, vr_list); + } + } + + if (vr_list) + vr_list->clear (); + + // Force symbols to be undefined again when this function exits. + + add_unwind_protect (clear_symbol_table, sym_tab); + + // Save old and set current symbol table context, for + // eval_undefined_error(). + + unwind_protect_ptr (curr_sym_tab); + curr_sym_tab = sym_tab; + + unwind_protect_ptr (curr_function); + curr_function = this; + + // XXX FIXME XXX -- ??? + // unwind_protect_ptr (args_passed); + + args_passed = args; + + string_vector arg_names = args.name_tags (); + + unwind_protect_int (num_args_passed); + num_args_passed = nargin; + + unwind_protect_int (num_named_args); + unwind_protect_int (curr_va_arg_number); + + if (param_list && ! param_list->varargs_only ()) + { + param_list->define_from_arg_vector (args); + if (error_state) + goto abort; + } + + if (ret_list && Vdefine_all_return_values) + { + octave_value tmp = builtin_any_variable ("default_return_value"); + + if (tmp.is_defined ()) + ret_list->initialize_undefined_elements (tmp); + } + + // The following code is in a separate scope to avoid warnings from + // G++ about `goto abort' crossing the initialization of some + // variables. + + { + bind_automatic_vars (arg_names, nargin, nargout); + + bool echo_commands = (Vecho_executing_commands & ECHO_FUNCTIONS); + + if (echo_commands) + print_code_function_header (); + + // Evaluate the commands that make up the function. + + octave_value_list tmp = cmd_list->eval (); + + octave_value last_computed_value; + + if (! tmp.empty ()) + last_computed_value = tmp(0); + + if (echo_commands) + print_code_function_trailer (); + + if (returning) + returning = 0; + + if (breaking) + breaking--; + + if (error_state) + { + traceback_error (); + goto abort; + } + + // Copy return values out. + + if (ret_list) + retval = ret_list->convert_to_const_vector (vr_list); + else if (Vreturn_last_computed_value) + retval(0) = last_computed_value; + } + + abort: + run_unwind_frame ("func_eval"); + + return retval; +} + +void +octave_user_function::traceback_error (void) +{ + if (error_state >= 0) + error_state = -1; + + if (fcn_name.empty ()) + { + if (file_name.empty ()) + ::error ("called from `?unknown?'"); + else + ::error ("called from file `%s'", file_name.c_str ()); + } + else + { + if (file_name.empty ()) + ::error ("called from `%s'", fcn_name.c_str ()); + else + ::error ("called from `%s' in file `%s'", + fcn_name.c_str (), file_name.c_str ()); + } +} + +void +octave_user_function::accept (tree_walker& tw) +{ + tw.visit_octave_user_function (*this); +} + +void +octave_user_function::print_code_function_header (void) +{ + tree_print_code tpc (octave_stdout, Vps4); + + tpc.visit_octave_user_function_header (*this); +} + +void +octave_user_function::print_code_function_trailer (void) +{ + tree_print_code tpc (octave_stdout, Vps4); + + tpc.visit_octave_user_function_trailer (*this); +} + +void +octave_user_function::install_automatic_vars (void) +{ + argn_sr = sym_tab->lookup ("argn", true); + nargin_sr = sym_tab->lookup ("nargin", true); + nargout_sr = sym_tab->lookup ("nargout", true); +} + +void +octave_user_function::bind_automatic_vars + (const string_vector& arg_names, int nargin, int nargout) +{ + if (! arg_names.empty ()) + argn_sr->define (arg_names); + + nargin_sr->define (static_cast (nargin)); + nargout_sr->define (static_cast (nargout)); +} + +DEFUN (va_arg, args, , + "va_arg (): return next argument in a function that takes a\n\ +variable number of parameters") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + { + if (curr_function) + { + if (curr_function->takes_varargs ()) + retval = curr_function->octave_va_arg (); + else + { + ::error ("va_arg only valid within function taking variable"); + ::error ("number of arguments"); + } + } + else + ::error ("va_arg only valid within function body"); + } + else + print_usage ("va_arg"); + + return retval; +} + +DEFUN (va_start, args, , + "va_start (): reset the pointer to the list of optional arguments\n\ +to the beginning") +{ + octave_value_list retval; + + int nargin = args.length (); + + if (nargin == 0) + { + if (curr_function) + { + if (curr_function->takes_varargs ()) + curr_function->octave_va_start (); + else + { + ::error ("va_start only valid within function taking variable"); + ::error ("number of arguments"); + } + } + else + ::error ("va_start only valid within function body"); + } + else + print_usage ("va_start"); + + return retval; +} + +DEFUN (vr_val, args, , + "vr_val (X): append X to the list of optional return values for a\n\ +function that allows a variable number of return values") +{ + octave_value_list 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"); + ::error ("produce a variable number of values"); + } + } + else + ::error ("vr_val only valid within function body"); + } + else + print_usage ("vr_val"); + + return retval; +} + +static int +define_all_return_values (void) +{ + Vdefine_all_return_values = check_preference ("define_all_return_values"); + + return 0; +} + +static int +return_last_computed_value (void) +{ + Vreturn_last_computed_value + = check_preference ("return_last_computed_value"); + + return 0; +} + +void +symbols_of_ov_usr_fcn (void) +{ + DEFVAR (default_return_value, Matrix (), 0, 0, + "the default for value for unitialized variables returned from\n\ +functions. Only used if the variable initialize_return_values is\n\ +set to \"true\"."); + + DEFVAR (define_all_return_values, 0.0, 0, define_all_return_values, + "control whether values returned from functions should have a\n\ +value even if one has not been explicitly assigned. See also\n\ +default_return_value"); + + DEFVAR (return_last_computed_value, 0.0, 0, return_last_computed_value, + "if a function does not return any values explicitly, return the\n\ + last computed value"); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov-usr-fcn.h b/src/ov-usr-fcn.h new file mode 100644 --- /dev/null +++ b/src/ov-usr-fcn.h @@ -0,0 +1,221 @@ +/* + +Copyright (C) 1996, 1997 John W. Eaton + +This file is part of Octave. + +Octave is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +Octave is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with Octave; see the file COPYING. If not, write to the Free +Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +*/ + +#if !defined (octave_user_function_h) +#define octave_user_function_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include + +#include + +#include "oct-obj.h" +#include "ov-fcn.h" +#include "ov-typeinfo.h" + +class string_vector; + +class octave_value; +class tree_parameter_list; +class tree_statement_list; +class tree_va_return_list; +class tree_walker; +class symbol_table; +class symbol_record; + +// Builtin functions. + +class +octave_user_function : public octave_function +{ +public: + + octave_user_function (tree_parameter_list *pl = 0, + tree_parameter_list *rl = 0, + tree_statement_list *cl = 0, + symbol_table *st = 0); + + ~octave_user_function (void); + + void *operator new (size_t size) + { return allocator.alloc (size); } + + void operator delete (void *p, size_t size) + { allocator.free (p, size); } + + octave_function *function_value (bool) { return this; } + + octave_user_function *define_param_list (tree_parameter_list *t); + + octave_user_function *define_ret_list (tree_parameter_list *t); + + void stash_fcn_file_name (void); + + void stash_fcn_file_time (time_t t) + { t_parsed = t; } + + void stash_symtab_ptr (symbol_record *sr) + { symtab_entry = sr; } + + string fcn_file_name (void) const + { return file_name; } + + time_t time_parsed (void) const + { return t_parsed; } + + void mark_as_system_fcn_file (void); + + bool is_system_fcn_file (void) const + { return system_fcn_file; } + + bool takes_varargs (void) const; + + void octave_va_start (void) + { curr_va_arg_number = num_named_args; } + + octave_value octave_va_arg (void); + + octave_value_list octave_all_va_args (void); + + bool takes_var_return (void) const; + + void octave_vr_val (const octave_value& val); + + void stash_function_name (const string& s); + + string function_name (void) + { return fcn_name; } + + octave_value_list do_index_op (int nargout, const octave_value_list& args); + + void traceback_error (void); + + tree_parameter_list *parameter_list (void) { return param_list; } + + tree_parameter_list *return_list (void) { return ret_list; } + + tree_statement_list *body (void) { return cmd_list; } + + void accept (tree_walker& tw); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + octave_user_function (void); + + octave_user_function (const octave_user_function& m); + + // List of arguments for this function. These are local variables. + tree_parameter_list *param_list; + + // List of parameters we return. These are also local variables in + // this function. + tree_parameter_list *ret_list; + + // The list of commands that make up the body of this function. + tree_statement_list *cmd_list; + + // The local symbol table for this function. + symbol_table *sym_tab; + + // The name of the file we parsed + string file_name; + + // The name of the function. + string fcn_name; + + // The time the file was parsed. + time_t t_parsed; + + // True if this function came from a file that is considered to be a + // system function. This affects whether we check the time stamp + // on the file to see if it has changed. + bool system_fcn_file; + + // Used to keep track of recursion depth. + int call_depth; + + // The number of arguments that have names. + int num_named_args; + + // The values that were passed as arguments. + octave_value_list args_passed; + + // The number of arguments passed in. + int num_args_passed; + + // Used to keep track of the current offset into the list of va_args. + int curr_va_arg_number; + + // The list of return values when an unspecified number can be + // returned. + tree_va_return_list *vr_list; + + // The symbol record for this function. + symbol_record *symtab_entry; + + // The symbol record for argn in the local symbol table. + symbol_record *argn_sr; + + // The symbol record for nargin in the local symbol table. + symbol_record *nargin_sr; + + // The symbol record for nargout in the local symbol table. + symbol_record *nargout_sr; + + // For custom memory management. + static octave_allocator allocator; + + // Type id of list objects, set by register_type(). + static int t_id; + + // Type name of list objects, defined in ov-list.cc. + static const string t_name; + + void print_code_function_header (void); + + void print_code_function_trailer (void); + + void install_automatic_vars (void); + + void bind_automatic_vars (const string_vector& arg_names, int nargin, + int nargout); +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/ov.cc b/src/ov.cc --- a/src/ov.cc +++ b/src/ov.cc @@ -31,6 +31,7 @@ #include "Array-flags.h" #include "str-vec.h" +#include "oct-obj.h" #include "oct-var-ref.h" #include "ov.h" #include "ov-base.h" @@ -48,6 +49,9 @@ #include "ov-list.h" #include "ov-colon.h" #include "ov-va-args.h" +#include "ov-builtin.h" +#include "ov-mapper.h" +#include "ov-usr-fcn.h" #include "ov-typeinfo.h" #include "defun.h" @@ -420,6 +424,12 @@ rep->count = 1; } +octave_value::octave_value (octave_function *f) + : rep (f) +{ + rep->count = 1; +} + octave_value::octave_value (const octave_value_list& l) : rep (new octave_list (l)) { @@ -479,6 +489,12 @@ } } +octave_value_list +octave_value::do_index_op (int nargout, const octave_value_list& idx) +{ + return rep->do_index_op (nargout, idx); +} + static void gripe_no_conversion (const string& tn1, const string& tn2) { @@ -557,12 +573,6 @@ return octave_variable_reference (); } -octave_value_list -octave_value::eval (int, const octave_value_list& idx) -{ - return (idx.length () > 0) ? do_index_op (idx) : *this; -} - Octave_map octave_value::map_value (void) const { @@ -581,6 +591,12 @@ return rep->stream_number (); } +octave_function * +octave_value::function_value (bool silent) +{ + return rep->function_value (silent); +} + octave_value_list octave_value::list_value (void) const { @@ -954,6 +970,9 @@ octave_list::register_type (); octave_all_va_args::register_type (); octave_magic_colon::register_type (); + octave_builtin::register_type (); + octave_mapper::register_type (); + octave_user_function::register_type (); } static int diff --git a/src/ov.h b/src/ov.h --- a/src/ov.h +++ b/src/ov.h @@ -39,10 +39,9 @@ #include "oct-alloc.h" #include "str-vec.h" -#include "oct-sym.h" - class Octave_map; class octave_stream; +class octave_function; class octave_value_list; class octave_variable_reference; @@ -74,7 +73,7 @@ typedef octave_value * (*type_conv_fcn) (const octave_value&); class -octave_value : public octave_symbol +octave_value { public: @@ -150,6 +149,7 @@ octave_value (const Range& r); octave_value (const Octave_map& m); octave_value (octave_stream *s, int n); + octave_value (octave_function *f); octave_value (const octave_value_list& m); octave_value (octave_value::magic_colon); octave_value (octave_value::all_va_args); @@ -213,9 +213,12 @@ virtual octave_value *try_narrowing_conversion (void) { return rep->try_narrowing_conversion (); } - virtual octave_value do_index_op (const octave_value_list& idx) const + virtual octave_value do_index_op (const octave_value_list& idx) { return rep->do_index_op (idx); } + virtual octave_value_list + do_index_op (int nargout, const octave_value_list& idx); + void assign (assign_op, const octave_value& rhs); void assign (assign_op, const octave_value_list& idx, @@ -343,15 +346,16 @@ virtual bool is_zero_by_zero (void) const { return rep->is_zero_by_zero (); } - bool is_constant (void) const - { return true; } + virtual bool is_constant (void) const + { return rep->is_constant (); } + + virtual bool is_function (void) const + { return rep->is_function (); } // Values. octave_value eval (void) { return *this; } - octave_value_list eval (int, const octave_value_list& idx); - virtual double double_value (bool frc_str_conv = false) const { return rep->double_value (frc_str_conv); } @@ -385,6 +389,8 @@ virtual int stream_number (void) const; + virtual octave_function *function_value (bool silent = false); + virtual octave_value_list list_value (void) const; virtual bool bool_value (void) const