changeset 2887:4b71bb90c388

[project @ 1997-04-28 01:20:55 by jwe]
author jwe
date Mon, 28 Apr 1997 01:20:56 +0000
parents 969032befa3d
children e78978eff91d
files src/pt-id.cc src/pt-id.h src/pt-indir.cc src/pt-indir.h
diffstat 4 files changed, 817 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
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 <config.h>
+#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: ***
+*/
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 <string>
+
+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: ***
+*/
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 <config.h>
+#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: ***
+*/
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 <string>
+
+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: ***
+*/