# HG changeset patch # User jwe # Date 862190456 0 # Node ID 4b71bb90c388bd5f4df1bd63f808b093f08e6289 # Parent 969032befa3d0e37d3b17b0060e06a688167a81d [project @ 1997-04-28 01:20:55 by jwe] diff --git a/src/pt-id.cc b/src/pt-id.cc new file mode 100644 --- /dev/null +++ b/src/pt-id.cc @@ -0,0 +1,362 @@ +/* + +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 "oct-fcn.h" +#include "oct-sym.h" +#include "symtab.h" +#include "pt-const.h" +#include "pt-id.h" +#include "pt-walk.h" +#include "utils.h" + +// Symbols from the symbol table. + +string +tree_identifier::name (void) const +{ + string retval; + if (sym) + retval = sym->name (); + return retval; +} + +tree_identifier * +tree_identifier::define (octave_symbol *s, unsigned int sym_type) +{ + int status = sym->define (s, sym_type); + return status ? this : 0; +} + +tree_identifier * +tree_identifier::define (octave_function *f, unsigned int sym_type) +{ + int status = sym->define (f, sym_type); + return status ? this : 0; +} + +tree_identifier * +tree_identifier::define (const octave_value& v) +{ + int status = sym->define (v); + return status ? this : 0; +} + +void +tree_identifier::document (const string& s) +{ + if (sym) + sym->document (s); +} + +octave_value +tree_identifier::assign (octave_value::assign_op op, const octave_value& rhs) +{ + octave_value retval; + + if (rhs.is_defined ()) + { + if (! sym->is_defined ()) + { + if (! (sym->is_formal_parameter () + || sym->is_linked_to_global ())) + { + link_to_builtin_variable (sym); + } + } + else if (sym->is_function ()) + { + sym->clear (); + } + + // XXX FIXME XXX -- make this work for ops other than `='. + + if (sym->define (rhs)) + retval = rhs; + } + + return retval; +} + +octave_value +tree_identifier::assign (octave_value::assign_op op, + const octave_value_list& args, + const octave_value& rhs) +{ + octave_value retval; + + if (rhs.is_defined ()) + { + if (! sym->is_defined ()) + { + if (! (sym->is_formal_parameter () + || sym->is_linked_to_global ())) + { + link_to_builtin_variable (sym); + } + } + else if (sym->is_function ()) + { + sym->clear (); + } + + if (sym->is_variable () && sym->is_defined ()) + { + sym->variable_reference () . assign (op, args, rhs); + } + else + { + assert (! sym->is_defined ()); + + if (! Vresize_on_range_error) + { + ::error ("indexed assignment to previously undefined variables"); + ::error ("is only possible when resize_on_range_error is true"); + } + else + { + retval.assign (op, args, rhs); + + if (retval.is_defined ()) + sym->define (retval); + } + } + } + + return retval; +} + +bool +tree_identifier::is_defined (void) +{ + return (sym && sym->is_defined ()); +} + +void +tree_identifier::increment (void) +{ + if (sym) + { + if (sym->is_read_only ()) + ::error ("can't redefined read-only variable `%s'", name ().c_str ()); + else if (sym->is_defined () && sym->is_variable ()) + reference () . increment (); + else + ::error ("can only increment variables"); + } +} + +void +tree_identifier::decrement (void) +{ + if (sym) + { + if (sym->is_read_only ()) + ::error ("can't redefined read-only variable `%s'", name ().c_str ()); + else if (sym->is_defined () && sym->is_variable ()) + reference () . decrement (); + else + ::error ("can only decrement variables"); + } +} + +void +tree_identifier::eval_undefined_error (void) +{ + int l = line (); + int c = column (); + + if (l == -1 && c == -1) + ::error ("`%s' undefined", name ().c_str ()); + else + ::error ("`%s' undefined near line %d column %d", + name ().c_str (), l, c); +} + +// Try to find a definition for an identifier. Here's how: +// +// * If the identifier is already defined and is a function defined +// in an function file that has been modified since the last time +// we parsed it, parse it again. +// +// * If the identifier is not defined, try to find a builtin +// variable or an already compiled function with the same name. +// +// * If the identifier is still undefined, try looking for an +// function file to parse. +// +// * On systems that support dynamic linking, we prefer .oct files +// over .m files. + +octave_symbol * +tree_identifier::do_lookup (bool& script_file_executed, bool exec_script) +{ + script_file_executed = lookup (sym, exec_script); + + octave_symbol *retval = 0; + + if (! script_file_executed) + retval = sym->def (); + + return retval; +} + +void +tree_identifier::link_to_global (void) +{ + if (sym) + link_to_global_variable (sym); +} + +void +tree_identifier::mark_as_static (void) +{ + if (sym) + sym->mark_as_static (); +} + +void +tree_identifier::mark_as_formal_parameter (void) +{ + if (sym) + sym->mark_as_formal_parameter (); +} + +octave_value +tree_identifier::eval (bool print) +{ + octave_value retval; + + if (error_state) + return retval; + + bool script_file_executed = false; + + octave_symbol *object_to_eval = do_lookup (script_file_executed); + + if (! script_file_executed) + { + if (object_to_eval) + { + int nargout = maybe_do_ans_assign ? 0 : 1; + + if (nargout) + { + octave_value_list tmp_args; + octave_value_list tmp = object_to_eval->eval (nargout, tmp_args); + + if (tmp.length () > 0) + retval = tmp(0); + } + else + retval = object_to_eval->eval (); + } + else + eval_undefined_error (); + } + + if (! error_state) + { + if (retval.is_defined ()) + { + if (maybe_do_ans_assign && ! object_to_eval->is_constant ()) + bind_ans (retval, print); + else if (print) + retval.print_with_name (name ()); + } + else if (object_to_eval && object_to_eval->is_constant ()) + eval_undefined_error (); + } + + return retval; +} + +octave_value_list +tree_identifier::eval (bool print, int nargout, const octave_value_list& args) +{ + octave_value_list retval; + + if (error_state) + return retval; + + bool script_file_executed = false; + + octave_symbol *object_to_eval = do_lookup (script_file_executed); + + if (! script_file_executed) + { + if (object_to_eval) + { + if (maybe_do_ans_assign && nargout == 1) + { + // Don't count the output arguments that we create + // automatically. + + nargout = 0; + + retval = object_to_eval->eval (nargout, args); + + if (retval.length () > 0 && retval(0).is_defined ()) + bind_ans (retval(0), print); + } + else + retval = object_to_eval->eval (nargout, args); + } + else + eval_undefined_error (); + } + + return retval; +} + +void +tree_identifier::accept (tree_walker& tw) +{ + tw.visit_identifier (*this); +} + +octave_value +tree_identifier::value (void) const +{ + return sym->variable_value (); +} + +octave_value& +tree_identifier::reference (void) +{ + return sym->variable_reference (); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/pt-id.h b/src/pt-id.h new file mode 100644 --- /dev/null +++ b/src/pt-id.h @@ -0,0 +1,126 @@ +/* + +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_tree_identifier_h) +#define octave_tree_identifier_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +class ostream; + +#include + +class octave_symbol; +class octave_function; +class symbol_record; + +class tree_walker; + +#include "pt-mvr-base.h" + +// Symbols from the symbol table. + +class +tree_identifier : public tree_multi_val_ret +{ + friend class tree_index_expression; + +public: + + tree_identifier (int l = -1, int c = -1) + : tree_multi_val_ret (l, c), sym (0), maybe_do_ans_assign (false) { } + + tree_identifier (symbol_record *s, int l = -1, int c = -1) + : tree_multi_val_ret (l, c), sym (s), maybe_do_ans_assign (false) { } + + ~tree_identifier (void) { } + + bool is_identifier (void) const + { return true; } + + string name (void) const; + + tree_identifier *define (octave_symbol *s, unsigned int sym_type); + + tree_identifier *define (octave_function *f, unsigned int sym_type); + + tree_identifier *define (const octave_value& v); + + void document (const string& s); + + octave_value assign (octave_value::assign_op op, + const octave_value& t); + + octave_value assign (octave_value::assign_op op, + const octave_value_list& args, + const octave_value& t); + + bool is_defined (void); + + void increment (void); + + void decrement (void); + + octave_symbol *do_lookup (bool& script_file_executed, bool + exec_script = true); + + void link_to_global (void); + + void mark_as_static (void); + + void mark_as_formal_parameter (void); + + void mark_for_possible_ans_assign (void) + { maybe_do_ans_assign = true; } + + octave_value eval (bool print = false); + + octave_value_list eval (bool print, int nargout, + const octave_value_list& args); + + void eval_undefined_error (void); + + void accept (tree_walker& tw); + + octave_value value (void) const; + + octave_value& reference (void); + +private: + + // The symbol record that this identifier references. + symbol_record *sym; + + // True if we should consider assigning the result of evaluating + // this identifier to the built-in variable ans. + bool maybe_do_ans_assign; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/pt-indir.cc b/src/pt-indir.cc new file mode 100644 --- /dev/null +++ b/src/pt-indir.cc @@ -0,0 +1,201 @@ +/* + +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-map.h" +#include "oct-obj.h" +#include "oct-sym.h" +#include "pager.h" +#include "symtab.h" +#include "pt-const.h" +#include "pt-id.h" +#include "pt-indir.h" +#include "pt-walk.h" +#include "utils.h" + +// Indirect references to values (structure elements). + +tree_indirect_ref::~tree_indirect_ref (void) +{ + if (! preserve_ident) + delete id; + + if (! preserve_indir) + delete indir; +} + +void +tree_indirect_ref::mark_for_possible_ans_assign (void) +{ + maybe_do_ans_assign = true; + + if (is_identifier_only ()) + id->mark_for_possible_ans_assign (); +} + +string +tree_indirect_ref::name (void) const +{ + string retval; + + if (is_identifier_only ()) + retval = id->name (); + else + { + if (id) + retval = id->name (); + else if (indir) + retval = indir->name (); + else + panic_impossible (); + + retval.append ("."); + retval.append (nm); + } + + return retval; +} + +octave_value +tree_indirect_ref::eval (bool print) +{ + octave_value retval; + + if (is_identifier_only ()) + retval = id->eval (print); + else + { + retval = value (); + + if (! error_state && retval.is_defined ()) + { + if (maybe_do_ans_assign) + bind_ans (retval, print); + else if (print) + retval.print_with_name (name ()); + } + } + + return retval; +} + +octave_value_list +tree_indirect_ref::eval (bool print, int nargout, + const octave_value_list& args) +{ + octave_value_list retval; + + if (is_identifier_only ()) + retval = id->eval (print, nargout, args); + else + { + octave_value tmp = value (); + + if (! error_state && tmp.is_defined ()) + { + retval = tmp.index (args); + + if (! error_state) + { + if (maybe_do_ans_assign && nargout == 1 + && retval.length () > 0 && retval(0).is_defined ()) + bind_ans (retval(0), print); + } + } + } + + return retval; +} + +void +tree_indirect_ref::accept (tree_walker& tw) +{ + tw.visit_indirect_ref (*this); +} + +octave_value +tree_indirect_ref::value (void) const +{ + octave_value retval; + + if (is_identifier_only ()) + retval = id->value (); + else + { + if (id) + retval = id->value (); + else if (indir) + retval = indir->value (); + else + panic_impossible (); + + if (! error_state) + retval = retval.struct_elt_val (nm); + } + + return retval; +} + +octave_value& +tree_indirect_ref::reference (void) +{ + if (is_identifier_only ()) + return id->reference (); + else + { + if (id) + { + octave_value& tmp = id->reference (); + if (tmp.is_undefined () || ! tmp.is_map ()) + tmp = Octave_map (); + return tmp.struct_elt_ref (nm); + } + else if (indir) + { + octave_value& tmp = indir->reference (); + if (tmp.is_undefined () || ! tmp.is_map ()) + tmp = Octave_map (); + return tmp.struct_elt_ref (nm); + } + else + { + static octave_value foo; + panic_impossible (); + return foo; + } + } +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/ diff --git a/src/pt-indir.h b/src/pt-indir.h new file mode 100644 --- /dev/null +++ b/src/pt-indir.h @@ -0,0 +1,128 @@ +/* + +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_tree_indirect_ref_h) +#define octave_tree_indirect_ref_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +class ostream; + +#include + +class tree_identifier; +class tree_walker; + +#include "pt-mvr-base.h" + +// Indirect references to values (structure references). + +class +tree_indirect_ref : public tree_multi_val_ret +{ +public: + + tree_indirect_ref (int l = -1, int c = -1) + : tree_multi_val_ret (l, c), id (0), indir (0), nm (), + preserve_ident (false), preserve_indir (false), + maybe_do_ans_assign (false) { } + + tree_indirect_ref (tree_identifier *i, int l = -1, int c = -1) + : tree_multi_val_ret (l, c), id (i), indir (0), nm (), + preserve_ident (false), preserve_indir (false), + maybe_do_ans_assign (false) { } + + tree_indirect_ref (tree_indirect_ref *i, const string& n, + int l = -1, int c = -1) + : tree_multi_val_ret (l, c), id (0), indir (i), nm (n), + preserve_ident (false), preserve_indir (false), + maybe_do_ans_assign (false) { } + + ~tree_indirect_ref (void); + + bool is_indirect_ref (void) const + { return true; } + + bool is_identifier_only (void) const + { return (id && nm.empty ()); } + + tree_identifier *ident (void) + { return id; } + + tree_indirect_ref *indirect (void) + { return indir; } + + void preserve_identifier (void) + { preserve_ident = true; } + + void preserve_indirect (void) + { preserve_indir = true; } + + void mark_for_possible_ans_assign (void); + + string name (void) const; + + octave_value eval (bool print = false); + + octave_value_list eval (bool print, int nargout, + const octave_value_list& args); + + octave_value value (void) const; + octave_value& reference (void); + + string elt_name (void) + { return nm; } + + void accept (tree_walker& tw); + +private: + + // The identifier for this structure reference. For example, in + // a.b.c, a is the id. + tree_identifier *id; + + // This element just points to another indirect reference. + tree_indirect_ref *indir; + + // The sub-element name. + string nm; + + // True if we should not delete the identifier. + bool preserve_ident; + + // True if we should not delete the indirect reference. + bool preserve_indir; + + // True if we should consider assigning the result of evaluating + // this identifier to the built-in variable ans. + bool maybe_do_ans_assign; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/