Mercurial > hg > octave-terminal
changeset 2980:cd5ad3fd8049
[project @ 1997-05-16 01:12:13 by jwe]
author | jwe |
---|---|
date | Fri, 16 May 1997 01:13:19 +0000 |
parents | a3556d2adec9 |
children | 38365813950d |
files | src/ChangeLog src/Makefile.in src/TEMPLATE-INST/SLList-expr.cc src/TEMPLATE-INST/SLList-misc.cc src/pt-assign.cc src/pt-assign.h src/pt-binop.cc src/pt-binop.h src/pt-colon.cc src/pt-colon.h src/pt-const.h src/pt-exp-base.cc src/pt-exp-base.h src/pt-exp.cc src/pt-exp.h src/pt-id.h src/pt-idx.cc src/pt-idx.h src/pt-indir.h src/pt-unop.cc src/pt-unop.h |
diffstat | 21 files changed, 1919 insertions(+), 1555 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ Thu May 15 11:48:10 1997 John W. Eaton <jwe@bevo.che.wisc.edu> + * pt-unop.h, pt-binop.h, pt-colon.h, pt-idx.h, pt-assign.h: + New files, extracted from pt-exp.h + * pt-unop.cc, pt-binop.cc, pt-colon.cc, pt-idx.cc, pt-assign.cc: + New files, extracted from pt-exp.cc + * pt-exp.h, pt-exp.cc: Rename from pt-exp-base.h, pt-exp-base.cc. + * oct-lvalue.h: Rename from oct-var-ref.h. Rename class from octave_variable_reference to octave_lvalue. Change all uses. * oct-lvalue.cc: Rename from oct-var-ref.cc.
--- a/src/Makefile.in +++ b/src/Makefile.in @@ -70,9 +70,10 @@ ov-str-mat.h ov-bool-mat.h ov-bool.h ov-file.h ov.h \ ov-fcn.h ov-builtin.h ov-mapper.h ov-usr-fcn.h ov-typeinfo.h -PT_INCLUDES := pt-base.h pt-cmd.h \ - pt-const.h pt-exp-base.h pt-exp.h pt-id.h pt-indir.h \ - pt-mat.h pt-misc.h pt-plot.h pt-pr-code.h pt-walk.h +PT_INCLUDES := pt-base.h pt-cmd.h pt-const.h pt-exp.h pt-id.h \ + pt-indir.h pt-mat.h pt-misc.h pt-plot.h pt-pr-code.h \ + pt-walk.h pt-unop.h pt-binop.h pt-colon.h pt-idx.h \ + pt-assign.h INCLUDES := BaseSLList.h Map.h SLList.h SLStack.h Stack.h defun-dld.h \ defun-int.h defun.h dirfns.h dynamic-ld.h error.h file-io.h \ @@ -109,9 +110,9 @@ ov-bool-mat.cc ov-bool.cc ov-file.cc ov.cc ov-fcn.cc \ ov-builtin.cc ov-mapper.cc ov-usr-fcn.cc ov-typeinfo.cc -PT_SRC := pt-base.cc pt-cmd.cc pt-const.cc pt-exp-base.cc \ - pt-exp.cc pt-id.cc pt-indir.cc pt-mat.cc pt-misc.cc \ - pt-plot.cc pt-pr-code.cc +PT_SRC := pt-base.cc pt-cmd.cc pt-const.cc pt-exp.cc pt-id.cc \ + pt-indir.cc pt-mat.cc pt-misc.cc pt-plot.cc pt-pr-code.cc \ + pt-unop.cc pt-binop.cc pt-colon.cc pt-idx.cc pt-assign.cc SOURCES := BaseSLList.cc Map.cc SLList.cc SLStack.cc Stack.cc \ data.cc defaults.cc defun.cc dirfns.cc dynamic-ld.cc \
--- a/src/TEMPLATE-INST/SLList-expr.cc +++ b/src/TEMPLATE-INST/SLList-expr.cc @@ -31,6 +31,8 @@ #include "ov.h" #include "pt-exp.h" +#include "pt-id.h" +#include "pt-idx.h" template class SLNode<tree_expression *>; template class SLList<tree_expression *>;
--- a/src/TEMPLATE-INST/SLList-misc.cc +++ b/src/TEMPLATE-INST/SLList-misc.cc @@ -30,8 +30,6 @@ #include "SLList.cc" #include "ov.h" -#include "pt-exp.h" -#include "ov.h" #include "pt-misc.h" template class SLNode<tree_argument_list *>;
new file mode 100644 --- /dev/null +++ b/src/pt-assign.cc @@ -0,0 +1,333 @@ +/* + +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 <iostream.h> +#include <strstream.h> + +#include "defun.h" +#include "error.h" +#include "input.h" +#include "oct-obj.h" +#include "oct-lvalue.h" +#include "pager.h" +#include "ov.h" +#include "pt-assign.h" +#include "pt-misc.h" +#include "pt-pr-code.h" +#include "pt-walk.h" +#include "utils.h" + +// Nonzero means we're returning from a function. +extern int returning; + +// Nonzero means we're breaking out of a loop or function body. +extern int breaking; + +// TRUE means print the right hand side of an assignment instead of +// the left. +static bool Vprint_rhs_assign_val; + +// Simple assignment expressions. + +tree_simple_assignment::~tree_simple_assignment (void) +{ + if (! preserve) + delete lhs; + + delete rhs; +} + +octave_value_list +tree_simple_assignment::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for expression X = RHS"); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_simple_assignment::rvalue (void) +{ + octave_value rhs_val; + + if (error_state) + return rhs_val; + + if (rhs) + { + octave_value_list tmp = rhs->rvalue (); + + if (! (error_state || tmp.empty ())) + { + rhs_val = tmp(0); + + if (rhs_val.is_undefined ()) + { + error ("value on right hand side of assignment is undefined"); + eval_error (); + } + else + { + octave_lvalue ult = lhs->lvalue (); + + if (error_state) + eval_error (); + else + { + ult.assign (etype, rhs_val); + + if (error_state) + eval_error (); + else if (! Vprint_rhs_assign_val) + { + octave_value lhs_val = ult.value (); + + if (! error_state && print_result ()) + { + if (Vprint_rhs_assign_val) + { + ostrstream buf; + + tree_print_code tpc (buf); + + lhs->accept (tpc); + + buf << ends; + + const char *tag = buf.str (); + + rhs_val.print_with_name (octave_stdout, tag); + + delete [] tag; + } + else + lhs_val.print_with_name (octave_stdout, + lhs->name ()); + } + } + } + } + } + else + eval_error (); + } + + return rhs_val; +} + +void +tree_simple_assignment::eval_error (void) +{ + if (error_state > 0) + { + int l = line (); + int c = column (); + + if (l != -1 && c != -1) + ::error ("evaluating assignment expression near line %d, column %d", + l, c); + } +} + +string +tree_simple_assignment::oper (void) const +{ + return octave_value::assign_op_as_string (etype); +} + +void +tree_simple_assignment::accept (tree_walker& tw) +{ + tw.visit_simple_assignment (*this); +} + +// Multi-valued assignment expressions. + +tree_multi_assignment::~tree_multi_assignment (void) +{ + if (! preserve) + delete lhs; + + delete rhs; +} + +octave_value +tree_multi_assignment::rvalue (void) +{ + octave_value retval; + + octave_value_list tmp = rvalue (1); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +octave_value_list +tree_multi_assignment::rvalue (int) +{ + octave_value_list rhs_val; + + if (error_state) + return rhs_val; + + if (rhs) + { + int n_out = lhs->length (); + + rhs_val = rhs->rvalue (n_out); + + if (! (error_state || rhs_val.empty ())) + { + if (rhs_val.empty ()) + { + error ("value on right hand side of assignment is undefined"); + eval_error (); + } + else + { + int k = 0; + + int n = rhs_val.length (); + + for (Pix p = lhs->first (); p != 0; lhs->next (p)) + { + tree_expression *lhs_elt = lhs->operator () (p); + + if (lhs_elt) + { + octave_lvalue ult = lhs_elt->lvalue (); + + if (error_state) + eval_error (); + else + { + octave_value tmp = k < n + ? rhs_val(k++) : octave_value (); + + if (tmp.is_defined ()) + { + // XXX FIXME XXX -- handle other assignment ops. + ult.assign (octave_value::asn_eq, tmp); + } + else + error ("element number %d undefined in return list", k); + + if (error_state) + eval_error (); + else if (! Vprint_rhs_assign_val) + { + octave_value lhs_val = ult.value (); + + if (! error_state && print_result ()) + { + if (Vprint_rhs_assign_val) + { + ostrstream buf; + + tree_print_code tpc (buf); + + lhs_elt->accept (tpc); + + buf << ends; + + const char *tag = buf.str (); + + tmp.print_with_name + (octave_stdout, tag); + + delete [] tag; + } + else + lhs_val.print_with_name (octave_stdout, + lhs_elt->name ()); + } + } + } + } + + if (error_state) + break; + } + } + } + else + eval_error (); + } + + return rhs_val; +} + +void +tree_multi_assignment::eval_error (void) +{ + if (error_state > 0) + { + int l = line (); + int c = column (); + + if (l != -1 && c != -1) + ::error ("evaluating assignment expression near line %d, column %d", + l, c); + } +} + +void +tree_multi_assignment::accept (tree_walker& tw) +{ + tw.visit_multi_assignment (*this); +} + +static int +print_rhs_assign_val (void) +{ + Vprint_rhs_assign_val = check_preference ("print_rhs_assign_val"); + + return 0; +} + +void +symbols_of_pt_assign (void) +{ + DEFVAR (print_rhs_assign_val, 0.0, 0, print_rhs_assign_val, + "if TRUE, print the right hand side of assignments instead of the left"); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-assign.h @@ -0,0 +1,153 @@ +/* + +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_assign_h) +#define octave_tree_assign_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <string> + +class ostream; + +class tree_argument_list; +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "ov.h" +#include "pt-exp.h" + +// Simple assignment expressions. + +class +tree_simple_assignment : public tree_expression +{ +public: + + tree_simple_assignment (bool plhs = false, int l = -1, int c = -1, + octave_value::assign_op t = octave_value::asn_eq) + : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), etype (t) { } + + tree_simple_assignment (tree_expression *le, tree_expression *re, + bool plhs = false, int l = -1, int c = -1, + octave_value::assign_op t = octave_value::asn_eq) + : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), + etype (t) { } + + ~tree_simple_assignment (void); + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + bool is_assignment_expression (void) const + { return true; } + + void eval_error (void); + + string oper (void) const; + + tree_expression *left_hand_side (void) { return lhs; } + + tree_expression *right_hand_side (void) { return rhs; } + + void accept (tree_walker& tw); + +private: + + void do_assign (octave_lvalue& ult, const octave_value_list& args, + const octave_value& rhs_val); + + void do_assign (octave_lvalue& ult, const octave_value& rhs_val); + + // The left hand side of the assignment. + tree_expression *lhs; + + // The right hand side of the assignment. + tree_expression *rhs; + + // True if we should not delete the lhs. + bool preserve; + + // True if this is an assignment to the built-in variable ans. + bool ans_ass; + + // The type of the expression. + octave_value::assign_op etype; +}; + +// Multi-valued assignment expressions. + +class +tree_multi_assignment : public tree_expression +{ +public: + + tree_multi_assignment (bool plhs = false, int l = -1, int c = -1) + : tree_expression (l, c), preserve (plhs), lhs (0), rhs (0) { } + + tree_multi_assignment (tree_argument_list *lst, tree_expression *r, + bool plhs = false, int l = -1, int c = -1) + : tree_expression (l, c), preserve (plhs), lhs (lst), rhs (r) { } + + ~tree_multi_assignment (void); + + bool is_assignment_expression (void) const + { return true; } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + void eval_error (void); + + tree_argument_list *left_hand_side (void) { return lhs; } + + tree_expression *right_hand_side (void) { return rhs; } + + void accept (tree_walker& tw); + +private: + + bool preserve; + tree_argument_list *lhs; + tree_expression *rhs; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-binop.cc @@ -0,0 +1,226 @@ +/* + +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 "ov.h" +#include "pt-binop.h" +#include "pt-pr-code.h" +#include "pt-walk.h" + +// Binary expressions. + +octave_value_list +tree_binary_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("binary operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_binary_expression::rvalue (void) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op_lhs) + { + octave_value a = op_lhs->rvalue (); + + if (error_state) + eval_error (); + else if (a.is_defined () && op_rhs) + { + octave_value b = op_rhs->rvalue (); + + if (error_state) + eval_error (); + else if (b.is_defined ()) + { + retval = ::do_binary_op (etype, a, b); + + if (error_state) + { + retval = octave_value (); + eval_error (); + } + } + else + eval_error (); + } + else + eval_error (); + } + else + eval_error (); + + return retval; +} + +void +tree_binary_expression::eval_error (void) +{ + if (error_state > 0) + ::error ("evaluating binary operator `%s' near line %d, column %d", + oper () . c_str (), line (), column ()); +} + +string +tree_binary_expression::oper (void) const +{ + return octave_value::binary_op_as_string (etype); +} + +void +tree_binary_expression::accept (tree_walker& tw) +{ + tw.visit_binary_expression (*this); +} + +// Boolean expressions. + +octave_value_list +tree_boolean_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("binary operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_boolean_expression::rvalue (void) +{ + octave_value retval; + + if (error_state) + return retval; + + bool result = false; + + if (op_lhs) + { + octave_value a = op_lhs->rvalue (); + + if (error_state) + eval_error (); + else + { + bool a_true = a.is_true (); + + if (error_state) + eval_error (); + else + { + if (a_true) + { + if (etype == bool_or) + { + result = true; + goto done; + } + } + else + { + if (etype == bool_and) + goto done; + } + + if (op_rhs) + { + octave_value b = op_rhs->rvalue (); + + if (error_state) + eval_error (); + else + { + result = b.is_true (); + + if (error_state) + eval_error (); + } + } + else + eval_error (); + + done: + + if (! error_state) + retval = octave_value (static_cast<double> (result)); + } + } + } + else + eval_error (); + + return retval; +} + +string +tree_boolean_expression::oper (void) const +{ + string retval = "<unknown>"; + + switch (etype) + { + case bool_and: + retval = "&&"; + break; + + case bool_or: + retval = "||"; + break; + + default: + break; + } + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-binop.h @@ -0,0 +1,137 @@ +/* + +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_binop_h) +#define octave_tree_binop_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <string> + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "ov.h" +#include "pt-exp.h" + +// Binary expressions. + +class +tree_binary_expression : public tree_expression +{ +public: + + tree_binary_expression (int l = -1, int c = -1, + octave_value::binary_op t + = octave_value::unknown_binary_op) + : tree_expression (l, c), op_lhs (0), op_rhs (0), etype (t) { } + + tree_binary_expression (tree_expression *a, tree_expression *b, + int l = -1, int c = -1, + octave_value::binary_op t + = octave_value::unknown_binary_op) + : tree_expression (l, c), op_lhs (a), op_rhs (b), etype (t) { } + + ~tree_binary_expression (void) + { + delete op_lhs; + delete op_rhs; + } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargou); + + void eval_error (void); + + string oper (void) const; + + tree_expression *lhs (void) { return op_lhs; } + tree_expression *rhs (void) { return op_rhs; } + + void accept (tree_walker& tw); + +protected: + + // The operands for the expression. + tree_expression *op_lhs; + tree_expression *op_rhs; + +private: + + // The type of the expression. + octave_value::binary_op etype; +}; + +// Boolean expressions. + +class +tree_boolean_expression : public tree_binary_expression +{ +public: + + enum type + { + unknown, + bool_and, + bool_or + }; + + tree_boolean_expression (int l = -1, int c = -1, type t = unknown) + : tree_binary_expression (l, c), etype (t) { } + + tree_boolean_expression (tree_expression *a, tree_expression *b, + int l = -1, int c = -1, type t = unknown) + : tree_binary_expression (a, b, l, c), etype (t) { } + + ~tree_boolean_expression (void) { } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + string oper (void) const; + +private: + + // The type of the expression. + type etype; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-colon.cc @@ -0,0 +1,184 @@ +/* + +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 "pager.h" +#include "ov.h" +#include "pt-colon.h" +#include "pt-pr-code.h" +#include "pt-walk.h" + +// Colon expressions. + +tree_colon_expression * +tree_colon_expression::append (tree_expression *t) +{ + tree_colon_expression *retval = 0; + + if (op_base) + { + if (op_limit) + { + if (op_increment) + ::error ("invalid colon expression"); + else + { + // Stupid syntax: + // + // base : limit + // base : increment : limit + + op_increment = op_limit; + op_limit = t; + } + } + else + op_limit = t; + + retval = this; + } + else + ::error ("invalid colon expression"); + + return retval; +} + +octave_value_list +tree_colon_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments for colon expression"); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_colon_expression::rvalue (void) +{ + octave_value retval; + + if (error_state || ! op_base || ! op_limit) + return retval; + + octave_value tmp = op_base->rvalue (); + + if (tmp.is_undefined ()) + { + eval_error ("invalid null value in colon expression"); + return retval; + } + + double xbase = tmp.double_value (); + + if (error_state) + { + eval_error ("colon expression elements must be scalars"); + return retval; + } + + tmp = op_limit->rvalue (); + + if (tmp.is_undefined ()) + { + eval_error ("invalid null value in colon expression"); + return retval; + } + + double xlimit = tmp.double_value (); + + if (error_state) + { + eval_error ("colon expression elements must be scalars"); + return retval; + } + + double xinc = 1.0; + + if (op_increment) + { + tmp = op_increment->rvalue (); + + if (tmp.is_undefined ()) + { + eval_error ("invalid null value in colon expression"); + return retval; + } + + xinc = tmp.double_value (); + + if (error_state) + { + eval_error ("colon expression elements must be scalars"); + return retval; + } + } + + retval = octave_value (xbase, xlimit, xinc); + + if (error_state) + { + if (error_state) + eval_error (); + + return octave_value (); + } + + return retval; +} + +void +tree_colon_expression::eval_error (const string& s) +{ + if (error_state > 0) + { + if (! s.empty ()) + ::error ("%s", s.c_str ()); + + ::error ("evaluating colon expression near line %d column %d", + line (), column ()); + } +} + +void +tree_colon_expression::accept (tree_walker& tw) +{ + tw.visit_colon_expression (*this); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-colon.h @@ -0,0 +1,93 @@ +/* + +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_colon_h) +#define octave_tree_colon 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <string> + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "pt-exp.h" + +// Colon expressions. + +class +tree_colon_expression : public tree_expression +{ +public: + + tree_colon_expression (int l = -1, int c = -1) + : tree_expression (l, c), op_base (0), op_limit (0), op_increment (0) { } + + tree_colon_expression (tree_expression *e, int l = -1, int c = -1) + : tree_expression (l, c), op_base (e), op_limit (0), op_increment (0) { } + + ~tree_colon_expression (void) + { + delete op_base; + delete op_limit; + delete op_increment; + } + + tree_colon_expression *append (tree_expression *t); + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + void eval_error (const string& s = string ()); + + tree_expression *base (void) { return op_base; } + + tree_expression *limit (void) { return op_limit; } + + tree_expression *increment (void) { return op_increment; } + + void accept (tree_walker& tw); + +private: + + // The components of the expression. + tree_expression *op_base; + tree_expression *op_limit; + tree_expression *op_increment; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
--- a/src/pt-const.h +++ b/src/pt-const.h @@ -33,7 +33,7 @@ #include "oct-alloc.h" -#include "pt-exp-base.h" +#include "pt-exp.h" class octave_value_list;
deleted file mode 100644 --- a/src/pt-exp-base.cc +++ /dev/null @@ -1,96 +0,0 @@ -/* - -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 <string> - -#include <iostream.h> -#include <strstream.h> - -#include "error.h" -#include "pager.h" -#include "oct-lvalue.h" -#include "ov.h" -#include "pt-exp-base.h" - -// Expressions. - -bool -tree_expression::is_logically_true (const char *warn_for) -{ - bool expr_value = false; - - octave_value t1 = rvalue (); - - if (! error_state) - { - if (t1.is_defined ()) - return t1.is_true (); - else - ::error ("%s: undefined value used in conditional expression", - warn_for); - } - else - ::error ("%s: error evaluating conditional expression", warn_for); - - return expr_value; -} - -octave_value -tree_expression::rvalue (void) -{ - ::error ("invalid rvalue function called in expression"); - return octave_value (); -} - -octave_value_list -tree_expression::rvalue (int nargout) -{ - ::error ("invalid rvalue function called in expression"); - return octave_value_list (); -} - -octave_lvalue -tree_expression::lvalue (void) -{ - ::error ("invalid lvalue function called in expression"); - return octave_lvalue (); -} - -string -tree_expression::original_text (void) const -{ - return string (); -} - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
deleted file mode 100644 --- a/src/pt-exp-base.h +++ /dev/null @@ -1,144 +0,0 @@ -/* - -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_expr_h) -#define octave_tree_expr_h 1 - -#if defined (__GNUG__) -#pragma interface -#endif - -#include <string> - -class octave_value; -class octave_lvalue; - -#include "pt-base.h" - -// A base class for expressions. - -class -tree_expression : public tree -{ -public: - - tree_expression (int l = -1, int c = -1) - : tree (l, c), num_parens (0), postfix_indexed (false), - print_flag (false) { } - - virtual ~tree_expression (void) { } - - virtual bool is_constant (void) const - { return false; } - - virtual bool is_matrix_constant (void) const - { return false; } - - virtual bool is_identifier (void) const - { return false; } - - virtual bool is_index_expression (void) const - { return false; } - - virtual bool is_indirect_ref (void) const - { return false; } - - virtual bool is_assignment_expression (void) const - { return false; } - - virtual bool is_prefix_expression (void) const - { return false; } - - virtual bool is_logically_true (const char *); - - virtual bool lvalue_ok (void) const - { return false; } - - virtual bool rvalue_ok (void) const - { return false; } - - virtual octave_value rvalue (void); - - virtual octave_value_list rvalue (int nargout); - - virtual octave_lvalue lvalue (void); - - int paren_count (void) const - { return num_parens; } - - bool is_postfix_indexed (void) const - { return postfix_indexed; } - - bool print_result (void) const - { return print_flag; } - - virtual string oper (void) const - { return "<unknown>"; } - - virtual string name (void) const - { return "<unknown>"; } - - virtual string original_text (void) const; - - tree_expression *mark_in_parens (void) - { - num_parens++; - return this; - } - - tree_expression *mark_postfix_indexed (void) - { - postfix_indexed = true; - return this; - } - - tree_expression *set_print_flag (bool print) - { - print_flag = print; - return this; - } - -protected: - - // A count of the number of times this expression appears directly - // inside a set of parentheses. - // - // (((e1)) + e2) ==> 2 for expression e1 - // ==> 1 for expression ((e1)) + e2 - // ==> 0 for expression e2 - int num_parens; - - // A flag that says whether this expression has an index associated - // with it. See the code in tree_identifier::rvalue for the rationale. - bool postfix_indexed; - - // Print result of rvalue for this expression? - bool print_flag; -}; - -#endif - -/* -;;; Local Variables: *** -;;; mode: C++ *** -;;; End: *** -*/
--- a/src/pt-exp.cc +++ b/src/pt-exp.cc @@ -28,971 +28,65 @@ #include <config.h> #endif +#include <string> + #include <iostream.h> #include <strstream.h> -#include "defun.h" #include "error.h" -#include "gripes.h" -#include "help.h" -#include "input.h" -#include "oct-obj.h" +#include "pager.h" #include "oct-lvalue.h" -#include "pager.h" #include "ov.h" #include "pt-exp.h" -#include "pt-id.h" -#include "pt-indir.h" -#include "pt-misc.h" -#include "pt-pr-code.h" -#include "pt-walk.h" -#include "utils.h" -#include "variables.h" -// Nonzero means we're returning from a function. -extern int returning; - -// Nonzero means we're breaking out of a loop or function body. -extern int breaking; - -// TRUE means print the right hand side of an assignment instead of -// the left. -static bool Vprint_rhs_assign_val; - -// Prefix expressions. - -octave_value_list -tree_prefix_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("prefix operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue (); - - return retval; -} - -octave_value -tree_prefix_expression::rvalue (void) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op) - { - if (etype == unot || etype == uminus) - { - octave_value val = op->rvalue (); - - if (! error_state) - { - if (val.is_defined ()) - { - if (etype == unot) - retval = val.not (); - else - retval = val.uminus (); - } - else - error ("argument to prefix operator `%s' undefined", - oper () . c_str ()); - } - } - else if (etype == increment || etype == decrement) - { - octave_lvalue ref = op->lvalue (); +// Expressions. - if (! error_state) - { - if (ref.is_defined ()) - { - if (etype == increment) - ref.increment (); - else - ref.decrement (); - - retval = ref.value (); - } - else - error ("argument to prefix operator `%s' undefined", - oper () . c_str ()); - } - } - else - error ("prefix operator %d not implemented", etype); - } - - return retval; -} - -void -tree_prefix_expression::eval_error (void) -{ - if (error_state > 0) - ::error ("evaluating prefix operator `%s' near line %d, column %d", - oper () . c_str (), line (), column ()); -} - -string -tree_prefix_expression::oper (void) const +bool +tree_expression::is_logically_true (const char *warn_for) { - string retval = "<unknown>"; - - switch (etype) - { - case unot: - retval = "!"; - break; - - case uminus: - retval = "-"; - break; - - case increment: - retval = "++"; - break; - - case decrement: - retval = "--"; - break; - - default: - break; - } - - return retval; -} - -void -tree_prefix_expression::accept (tree_walker& tw) -{ - tw.visit_prefix_expression (*this); -} - -// Postfix expressions. - -octave_value_list -tree_postfix_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("postfix operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue (); - - return retval; -} + bool expr_value = false; -octave_value -tree_postfix_expression::rvalue (void) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op) - { - if (etype == transpose || etype == hermitian) - { - octave_value val = op->rvalue (); - - if (! error_state) - { - if (val.is_defined ()) - { - if (etype == transpose) - retval = val.transpose (); - else - retval = val.hermitian (); - } - else - error ("argument to postfix operator `%s' undefined", - oper () . c_str ()); - } - } - else if (etype == increment || etype == decrement) - { - octave_lvalue ref = op->lvalue (); - - if (! error_state) - { - if (ref.is_defined ()) - { - retval = ref.value (); - - if (etype == increment) - ref.increment (); - else - ref.decrement (); - } - else - error ("argument to postfix operator `%s' undefined", - oper () . c_str ()); - } - } - else - error ("postfix operator %d not implemented", etype); - } - - return retval; -} - -void -tree_postfix_expression::eval_error (void) -{ - if (error_state > 0) - ::error ("evaluating postfix operator `%s' near line %d, column %d", - oper () . c_str (), line (), column ()); -} - -string -tree_postfix_expression::oper (void) const -{ - string retval = "<unknown>"; - - switch (etype) - { - case transpose: - retval = ".'"; - break; + octave_value t1 = rvalue (); - case hermitian: - retval = "'"; - break; - - case increment: - retval = "++"; - break; - - case decrement: - retval = "--"; - break; - - default: - break; - } - - return retval; -} - -void -tree_postfix_expression::accept (tree_walker& tw) -{ - tw.visit_postfix_expression (*this); -} - -// Binary expressions. - -octave_value_list -tree_binary_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("binary operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue (); - - return retval; -} - -octave_value -tree_binary_expression::rvalue (void) -{ - octave_value retval; - - if (error_state) - return retval; - - if (op_lhs) + if (! error_state) { - octave_value a = op_lhs->rvalue (); - - if (error_state) - eval_error (); - else if (a.is_defined () && op_rhs) - { - octave_value b = op_rhs->rvalue (); - - if (error_state) - eval_error (); - else if (b.is_defined ()) - { - retval = ::do_binary_op (etype, a, b); - - if (error_state) - { - retval = octave_value (); - eval_error (); - } - } - else - eval_error (); - } + if (t1.is_defined ()) + return t1.is_true (); else - eval_error (); + ::error ("%s: undefined value used in conditional expression", + warn_for); } else - eval_error (); - - return retval; -} - -void -tree_binary_expression::eval_error (void) -{ - if (error_state > 0) - ::error ("evaluating binary operator `%s' near line %d, column %d", - oper () . c_str (), line (), column ()); -} - -string -tree_binary_expression::oper (void) const -{ - return octave_value::binary_op_as_string (etype); -} - -void -tree_binary_expression::accept (tree_walker& tw) -{ - tw.visit_binary_expression (*this); -} - -// Boolean expressions. - -octave_value_list -tree_boolean_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("binary operator `%s': invalid number of output arguments", - oper () . c_str ()); - else - retval = rvalue (); - - return retval; -} - -octave_value -tree_boolean_expression::rvalue (void) -{ - octave_value retval; - - if (error_state) - return retval; - - bool result = false; - - if (op_lhs) - { - octave_value a = op_lhs->rvalue (); - - if (error_state) - eval_error (); - else - { - bool a_true = a.is_true (); + ::error ("%s: error evaluating conditional expression", warn_for); - if (error_state) - eval_error (); - else - { - if (a_true) - { - if (etype == bool_or) - { - result = true; - goto done; - } - } - else - { - if (etype == bool_and) - goto done; - } - - if (op_rhs) - { - octave_value b = op_rhs->rvalue (); - - if (error_state) - eval_error (); - else - { - result = b.is_true (); - - if (error_state) - eval_error (); - } - } - else - eval_error (); - - done: - - if (! error_state) - retval = octave_value (static_cast<double> (result)); - } - } - } - else - eval_error (); - - return retval; -} - -string -tree_boolean_expression::oper (void) const -{ - string retval = "<unknown>"; - - switch (etype) - { - case bool_and: - retval = "&&"; - break; - - case bool_or: - retval = "||"; - break; - - default: - break; - } - - return retval; -} - -// Simple assignment expressions. - -tree_simple_assignment::~tree_simple_assignment (void) -{ - if (! preserve) - delete lhs; - - delete rhs; -} - -octave_value_list -tree_simple_assignment::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for expression X = RHS"); - else - retval = rvalue (); - - return retval; + return expr_value; } octave_value -tree_simple_assignment::rvalue (void) -{ - octave_value rhs_val; - - if (error_state) - return rhs_val; - - if (rhs) - { - octave_value_list tmp = rhs->rvalue (); - - if (! (error_state || tmp.empty ())) - { - rhs_val = tmp(0); - - if (rhs_val.is_undefined ()) - { - error ("value on right hand side of assignment is undefined"); - eval_error (); - } - else - { - octave_lvalue ult = lhs->lvalue (); - - if (error_state) - eval_error (); - else - { - ult.assign (etype, rhs_val); - - if (error_state) - eval_error (); - else if (! Vprint_rhs_assign_val) - { - octave_value lhs_val = ult.value (); - - if (! error_state && print_result ()) - { - if (Vprint_rhs_assign_val) - { - ostrstream buf; - - tree_print_code tpc (buf); - - lhs->accept (tpc); - - buf << ends; - - const char *tag = buf.str (); - - rhs_val.print_with_name (octave_stdout, tag); - - delete [] tag; - } - else - lhs_val.print_with_name (octave_stdout, - lhs->name ()); - } - } - } - } - } - else - eval_error (); - } - - return rhs_val; -} - -void -tree_simple_assignment::eval_error (void) -{ - if (error_state > 0) - { - int l = line (); - int c = column (); - - if (l != -1 && c != -1) - ::error ("evaluating assignment expression near line %d, column %d", - l, c); - } -} - -string -tree_simple_assignment::oper (void) const -{ - return octave_value::assign_op_as_string (etype); -} - -void -tree_simple_assignment::accept (tree_walker& tw) -{ - tw.visit_simple_assignment (*this); -} - -// Colon expressions. - -tree_colon_expression * -tree_colon_expression::append (tree_expression *t) +tree_expression::rvalue (void) { - tree_colon_expression *retval = 0; - - if (op_base) - { - if (op_limit) - { - if (op_increment) - ::error ("invalid colon expression"); - else - { - // Stupid syntax: - // - // base : limit - // base : increment : limit - - op_increment = op_limit; - op_limit = t; - } - } - else - op_limit = t; - - retval = this; - } - else - ::error ("invalid colon expression"); - - return retval; -} - -octave_value_list -tree_colon_expression::rvalue (int nargout) -{ - octave_value_list retval; - - if (nargout > 1) - error ("invalid number of output arguments for colon expression"); - else - retval = rvalue (); - - return retval; -} - -octave_value -tree_colon_expression::rvalue (void) -{ - octave_value retval; - - if (error_state || ! op_base || ! op_limit) - return retval; - - octave_value tmp = op_base->rvalue (); - - if (tmp.is_undefined ()) - { - eval_error ("invalid null value in colon expression"); - return retval; - } - - double xbase = tmp.double_value (); - - if (error_state) - { - eval_error ("colon expression elements must be scalars"); - return retval; - } - - tmp = op_limit->rvalue (); - - if (tmp.is_undefined ()) - { - eval_error ("invalid null value in colon expression"); - return retval; - } - - double xlimit = tmp.double_value (); - - if (error_state) - { - eval_error ("colon expression elements must be scalars"); - return retval; - } - - double xinc = 1.0; - - if (op_increment) - { - tmp = op_increment->rvalue (); - - if (tmp.is_undefined ()) - { - eval_error ("invalid null value in colon expression"); - return retval; - } - - xinc = tmp.double_value (); - - if (error_state) - { - eval_error ("colon expression elements must be scalars"); - return retval; - } - } - - retval = octave_value (xbase, xlimit, xinc); - - if (error_state) - { - if (error_state) - eval_error (); - - return octave_value (); - } - - return retval; -} - -void -tree_colon_expression::eval_error (const string& s) -{ - if (error_state > 0) - { - if (! s.empty ()) - ::error ("%s", s.c_str ()); - - ::error ("evaluating colon expression near line %d column %d", - line (), column ()); - } -} - -void -tree_colon_expression::accept (tree_walker& tw) -{ - tw.visit_colon_expression (*this); -} - -tree_index_expression::~tree_index_expression (void) -{ - delete expr; - delete list; + ::error ("invalid rvalue function called in expression"); + return octave_value (); } octave_value_list -tree_index_expression::rvalue (int nargout) +tree_expression::rvalue (int nargout) { - octave_value_list retval; - - if (error_state) - return retval; - - octave_value tmp = expr->rvalue (); - - if (! error_state) - { - octave_value_list args; - - if (list) - args = list->convert_to_const_vector (); - - if (! error_state) - { - if (! args.empty ()) - args.stash_name_tags (arg_nm); - - // XXX FIXME XXX -- is this the right thing to do? - if (tmp.is_constant ()) - retval = tmp.do_index_op (args); - else - retval = tmp.do_index_op (nargout, args); - } - else - eval_error (); - } - else - eval_error (); - - return retval; -} - -octave_value -tree_index_expression::rvalue (void) -{ - octave_value retval; - - octave_value_list tmp = rvalue (1); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; + ::error ("invalid rvalue function called in expression"); + return octave_value_list (); } octave_lvalue -tree_index_expression::lvalue (void) -{ - octave_lvalue retval; - - if (! error_state) - { - retval = expr->lvalue (); - - if (! error_state) - { - octave_value_list args; - - if (list) - args = list->convert_to_const_vector (); - - retval.index (args); - } - } - - return retval; -} - -void -tree_index_expression::eval_error (void) +tree_expression::lvalue (void) { - if (error_state > 0) - { - int l = line (); - int c = column (); - - if (l != -1 && c != -1) - { - if (list) - ::error ("evaluating index expression near line %d, column %d", - l, c); - else - ::error ("evaluating expression near line %d, column %d", l, c); - } - else - { - if (list) - ::error ("evaluating index expression"); - else - ::error ("evaluating expression"); - } - } -} - -void -tree_index_expression::accept (tree_walker& tw) -{ - tw.visit_index_expression (*this); -} - -tree_multi_assignment::~tree_multi_assignment (void) -{ - if (! preserve) - delete lhs; - - delete rhs; -} - -octave_value -tree_multi_assignment::rvalue (void) -{ - octave_value retval; - - octave_value_list tmp = rvalue (1); - - if (! tmp.empty ()) - retval = tmp(0); - - return retval; + ::error ("invalid lvalue function called in expression"); + return octave_lvalue (); } -octave_value_list -tree_multi_assignment::rvalue (int nargout) +string +tree_expression::original_text (void) const { - octave_value_list rhs_val; - - if (error_state) - return rhs_val; - - if (rhs) - { - int n_out = lhs->length (); - - rhs_val = rhs->rvalue (n_out); - - if (! (error_state || rhs_val.empty ())) - { - if (rhs_val.empty ()) - { - error ("value on right hand side of assignment is undefined"); - eval_error (); - } - else - { - int k = 0; - - int n = rhs_val.length (); - - for (Pix p = lhs->first (); p != 0; lhs->next (p)) - { - tree_expression *lhs_elt = lhs->operator () (p); - - if (lhs_elt) - { - octave_lvalue ult = lhs_elt->lvalue (); - - if (error_state) - eval_error (); - else - { - octave_value tmp = k < n - ? rhs_val(k++) : octave_value (); - - if (tmp.is_defined ()) - { - // XXX FIXME XXX -- handle other assignment ops. - ult.assign (octave_value::asn_eq, tmp); - } - else - error ("element number %d undefined in return list", k); - - if (error_state) - eval_error (); - else if (! Vprint_rhs_assign_val) - { - octave_value lhs_val = ult.value (); - - if (! error_state && print_result ()) - { - if (Vprint_rhs_assign_val) - { - ostrstream buf; - - tree_print_code tpc (buf); - - lhs_elt->accept (tpc); - - buf << ends; - - const char *tag = buf.str (); - - tmp.print_with_name - (octave_stdout, tag); - - delete [] tag; - } - else - lhs_val.print_with_name (octave_stdout, - lhs_elt->name ()); - } - } - } - } - - if (error_state) - break; - } - } - } - else - eval_error (); - } - - return rhs_val; -} - -void -tree_multi_assignment::eval_error (void) -{ - if (error_state > 0) - { - int l = line (); - int c = column (); - - if (l != -1 && c != -1) - ::error ("evaluating assignment expression near line %d, column %d", - l, c); - } -} - -void -tree_multi_assignment::accept (tree_walker& tw) -{ - tw.visit_multi_assignment (*this); -} - -static int -print_rhs_assign_val (void) -{ - Vprint_rhs_assign_val = check_preference ("print_rhs_assign_val"); - - return 0; -} - -void -symbols_of_pt_exp (void) -{ - DEFVAR (print_rhs_assign_val, 0.0, 0, print_rhs_assign_val, - "if TRUE, print the right hand side of assignments instead of the left"); + return string (); } /*
--- a/src/pt-exp.h +++ b/src/pt-exp.h @@ -20,421 +20,119 @@ */ -#if !defined (octave_tree_expr2_h) -#define octave_tree_expr2_h 1 +#if !defined (octave_tree_expr_h) +#define octave_tree_expr_h 1 #if defined (__GNUG__) #pragma interface #endif -class ostream; - -class tree_identifier; -class tree_index_expression; -class tree_indirect_ref; -class tree_argument_list; -class tree_assignment_lhs; - -class tree_walker; +#include <string> class octave_value; -class octave_value_list; class octave_lvalue; -#include "oct-obj.h" -#include "pt-exp-base.h" - -// Unary expressions. - -class -tree_unary_expression : public tree_expression -{ -public: - - tree_unary_expression (int l = -1, int c = -1) - : tree_expression (l, c), op (0) { } - - tree_unary_expression (tree_expression *e, int l = -1, int c = -1) - : tree_expression (l, c), op (e) { } - - ~tree_unary_expression (void) { delete op; } - - tree_expression *operand (void) { return op; } - -protected: - - // The operand for the expression. - tree_expression *op; -}; - -// Prefix expressions. - -class -tree_prefix_expression : public tree_unary_expression -{ -public: +#include "pt-base.h" - enum type - { - unknown, - unot, - uminus, - increment, - decrement - }; - - tree_prefix_expression (int l = -1, int c = -1) - : tree_unary_expression (l, c), etype (unknown) { } - - tree_prefix_expression (type t = unknown, tree_expression *e, - int l = -1, int c = -1) - : tree_unary_expression (e, l, c), etype (t) { } - - ~tree_prefix_expression (void) { } - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargou); - - void eval_error (void); - - string oper (void) const; - - void accept (tree_walker& tw); - -private: - - // The type of the expression. - type etype; -}; - -// Postfix expressions. +// A base class for expressions. class -tree_postfix_expression : public tree_unary_expression -{ -public: - - enum type - { - unknown, - hermitian, - transpose, - increment, - decrement - }; - - tree_postfix_expression (int l = -1, int c = -1) - : tree_unary_expression (l, c), etype (unknown) { } - - tree_postfix_expression (type t = unknown, tree_expression *e, - int l = -1, int c = -1) - : tree_unary_expression (e, l, c), etype (t) { } - - ~tree_postfix_expression (void) { } - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargout); - - void eval_error (void); - - string oper (void) const; - - void accept (tree_walker& tw); - -private: - - // The type of the expression. - type etype; -}; - -// Binary expressions. - -class -tree_binary_expression : public tree_expression -{ -public: - - tree_binary_expression (int l = -1, int c = -1, - octave_value::binary_op t - = octave_value::unknown_binary_op) - : tree_expression (l, c), op_lhs (0), op_rhs (0), etype (t) { } - - tree_binary_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1, - octave_value::binary_op t - = octave_value::unknown_binary_op) - : tree_expression (l, c), op_lhs (a), op_rhs (b), etype (t) { } - - ~tree_binary_expression (void) - { - delete op_lhs; - delete op_rhs; - } - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargou); - - void eval_error (void); - - string oper (void) const; - - tree_expression *lhs (void) { return op_lhs; } - tree_expression *rhs (void) { return op_rhs; } - - void accept (tree_walker& tw); - -protected: - - // The operands for the expression. - tree_expression *op_lhs; - tree_expression *op_rhs; - -private: - - // The type of the expression. - octave_value::binary_op etype; -}; - -// Boolean expressions. - -class -tree_boolean_expression : public tree_binary_expression +tree_expression : public tree { public: - enum type - { - unknown, - bool_and, - bool_or - }; + tree_expression (int l = -1, int c = -1) + : tree (l, c), num_parens (0), postfix_indexed (false), + print_flag (false) { } - tree_boolean_expression (int l = -1, int c = -1, type t = unknown) - : tree_binary_expression (l, c), etype (t) { } + virtual ~tree_expression (void) { } - tree_boolean_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1, type t = unknown) - : tree_binary_expression (a, b, l, c), etype (t) { } - - ~tree_boolean_expression (void) { } + virtual bool is_constant (void) const + { return false; } - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargout); - - string oper (void) const; - -private: + virtual bool is_matrix_constant (void) const + { return false; } - // The type of the expression. - type etype; -}; + virtual bool is_identifier (void) const + { return false; } -// Simple assignment expressions. - -class -tree_simple_assignment : public tree_expression -{ -public: + virtual bool is_index_expression (void) const + { return false; } - tree_simple_assignment (bool plhs = false, int l = -1, int c = -1, - octave_value::assign_op t = octave_value::asn_eq) - : tree_expression (l, c), lhs (0), rhs (0), preserve (plhs), etype (t) { } + virtual bool is_indirect_ref (void) const + { return false; } - tree_simple_assignment (tree_expression *le, tree_expression *re, - bool plhs = false, int l = -1, int c = -1, - octave_value::assign_op t = octave_value::asn_eq) - : tree_expression (l, c), lhs (le), rhs (re), preserve (plhs), - etype (t) { } + virtual bool is_assignment_expression (void) const + { return false; } - ~tree_simple_assignment (void); + virtual bool is_prefix_expression (void) const + { return false; } - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); + virtual bool is_logically_true (const char *); - octave_value_list rvalue (int nargout); - - bool is_assignment_expression (void) const - { return true; } + virtual bool lvalue_ok (void) const + { return false; } - void eval_error (void); - - string oper (void) const; - - tree_expression *left_hand_side (void) { return lhs; } - - tree_expression *right_hand_side (void) { return rhs; } + virtual bool rvalue_ok (void) const + { return false; } - void accept (tree_walker& tw); + virtual octave_value rvalue (void); -private: - - void do_assign (octave_lvalue& ult, const octave_value_list& args, - const octave_value& rhs_val); + virtual octave_value_list rvalue (int nargout); - void do_assign (octave_lvalue& ult, const octave_value& rhs_val); + virtual octave_lvalue lvalue (void); - // The left hand side of the assignment. - tree_expression *lhs; - - // The right hand side of the assignment. - tree_expression *rhs; + int paren_count (void) const + { return num_parens; } - // True if we should not delete the lhs. - bool preserve; - - // True if this is an assignment to the built-in variable ans. - bool ans_ass; + bool is_postfix_indexed (void) const + { return postfix_indexed; } - // The type of the expression. - octave_value::assign_op etype; -}; + bool print_result (void) const + { return print_flag; } -// Colon expressions. + virtual string oper (void) const + { return "<unknown>"; } -class -tree_colon_expression : public tree_expression -{ -public: + virtual string name (void) const + { return "<unknown>"; } - tree_colon_expression (int l = -1, int c = -1) - : tree_expression (l, c), op_base (0), op_limit (0), op_increment (0) { } + virtual string original_text (void) const; - tree_colon_expression (tree_expression *e, int l = -1, int c = -1) - : tree_expression (l, c), op_base (e), op_limit (0), op_increment (0) { } - - ~tree_colon_expression (void) + tree_expression *mark_in_parens (void) { - delete op_base; - delete op_limit; - delete op_increment; + num_parens++; + return this; } - tree_colon_expression *append (tree_expression *t); - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargout); - - void eval_error (const string& s = string ()); - - tree_expression *base (void) { return op_base; } - tree_expression *limit (void) { return op_limit; } - tree_expression *increment (void) { return op_increment; } - - void accept (tree_walker& tw); - -private: - - // The components of the expression. - tree_expression *op_base; - tree_expression *op_limit; - tree_expression *op_increment; -}; - -// Index expressions. + tree_expression *mark_postfix_indexed (void) + { + postfix_indexed = true; + return this; + } -class -tree_index_expression : public tree_expression -{ -public: - - tree_index_expression (tree_expression *e = 0, tree_argument_list *lst = 0, - int l = -1, int c = -1) - : tree_expression (l, c), expr (e), list (lst), arg_nm () { } - - ~tree_index_expression (void); + tree_expression *set_print_flag (bool print) + { + print_flag = print; + return this; + } - bool is_index_expression (void) const - { return true; } - - tree_expression *expression (void) - { return expr; } - - tree_argument_list *arg_list (void) - { return list; } - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); - - octave_value_list rvalue (int nargout); +protected: - octave_lvalue lvalue (void); - - void eval_error (void); - - void accept (tree_walker& tw); - -private: - - tree_expression *expr; - - tree_argument_list *list; - - string_vector arg_nm; -}; - -// Multi-valued assignment expressions. - -class -tree_multi_assignment : public tree_expression -{ -public: - - tree_multi_assignment (bool plhs = false, int l = -1, int c = -1) - : tree_expression (l, c), preserve (plhs), lhs (0), rhs (0) { } + // A count of the number of times this expression appears directly + // inside a set of parentheses. + // + // (((e1)) + e2) ==> 2 for expression e1 + // ==> 1 for expression ((e1)) + e2 + // ==> 0 for expression e2 + int num_parens; - tree_multi_assignment (tree_argument_list *lst, tree_expression *r, - bool plhs = false, int l = -1, int c = -1) - : tree_expression (l, c), preserve (plhs), lhs (lst), rhs (r) { } - - ~tree_multi_assignment (void); - - bool is_assignment_expression (void) const - { return true; } - - bool rvalue_ok (void) const - { return true; } - - octave_value rvalue (void); + // A flag that says whether this expression has an index associated + // with it. See the code in tree_identifier::rvalue for the rationale. + bool postfix_indexed; - octave_value_list rvalue (int nargout); - - void eval_error (void); - - tree_argument_list *left_hand_side (void) { return lhs; } - - tree_expression *right_hand_side (void) { return rhs; } - - void accept (tree_walker& tw); - -private: - - bool preserve; - tree_argument_list *lhs; - tree_expression *rhs; + // Print result of rvalue for this expression? + bool print_flag; }; #endif
--- a/src/pt-id.h +++ b/src/pt-id.h @@ -38,7 +38,7 @@ class tree_walker; -#include "pt-exp-base.h" +#include "pt-exp.h" // Symbols from the symbol table.
new file mode 100644 --- /dev/null +++ b/src/pt-idx.cc @@ -0,0 +1,157 @@ +/* + +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-lvalue.h" +#include "ov.h" +#include "pt-idx.h" +#include "pt-misc.h" +#include "pt-pr-code.h" +#include "pt-walk.h" + +// Index expressions. + +tree_index_expression::~tree_index_expression (void) +{ + delete expr; + delete list; +} + +octave_value_list +tree_index_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (error_state) + return retval; + + octave_value tmp = expr->rvalue (); + + if (! error_state) + { + octave_value_list args; + + if (list) + args = list->convert_to_const_vector (); + + if (! error_state) + { + if (! args.empty ()) + args.stash_name_tags (arg_nm); + + // XXX FIXME XXX -- is this the right thing to do? + if (tmp.is_constant ()) + retval = tmp.do_index_op (args); + else + retval = tmp.do_index_op (nargout, args); + } + else + eval_error (); + } + else + eval_error (); + + return retval; +} + +octave_value +tree_index_expression::rvalue (void) +{ + octave_value retval; + + octave_value_list tmp = rvalue (1); + + if (! tmp.empty ()) + retval = tmp(0); + + return retval; +} + +octave_lvalue +tree_index_expression::lvalue (void) +{ + octave_lvalue retval; + + if (! error_state) + { + retval = expr->lvalue (); + + if (! error_state) + { + octave_value_list args; + + if (list) + args = list->convert_to_const_vector (); + + retval.index (args); + } + } + + return retval; +} + +void +tree_index_expression::eval_error (void) +{ + if (error_state > 0) + { + int l = line (); + int c = column (); + + if (l != -1 && c != -1) + { + if (list) + ::error ("evaluating index expression near line %d, column %d", + l, c); + else + ::error ("evaluating expression near line %d, column %d", l, c); + } + else + { + if (list) + ::error ("evaluating index expression"); + else + ::error ("evaluating expression"); + } + } +} + +void +tree_index_expression::accept (tree_walker& tw) +{ + tw.visit_index_expression (*this); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-idx.h @@ -0,0 +1,92 @@ +/* + +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_index_h) +#define octave_tree_index_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +class tree_argument_list; + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "str-vec.h" + +#include "pt-exp.h" + +// Index expressions. + +class +tree_index_expression : public tree_expression +{ +public: + + tree_index_expression (tree_expression *e = 0, tree_argument_list *lst = 0, + int l = -1, int c = -1) + : tree_expression (l, c), expr (e), list (lst), arg_nm () { } + + ~tree_index_expression (void); + + bool is_index_expression (void) const + { return true; } + + tree_expression *expression (void) + { return expr; } + + tree_argument_list *arg_list (void) + { return list; } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + octave_lvalue lvalue (void); + + void eval_error (void); + + void accept (tree_walker& tw); + +private: + + tree_expression *expr; + + tree_argument_list *list; + + string_vector arg_nm; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
--- a/src/pt-indir.h +++ b/src/pt-indir.h @@ -35,7 +35,7 @@ class octave_value_list; class tree_walker; -#include "pt-exp-base.h" +#include "pt-exp.h" // Indirect references to values (structure references).
new file mode 100644 --- /dev/null +++ b/src/pt-unop.cc @@ -0,0 +1,273 @@ +/* + +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-lvalue.h" +#include "ov.h" +#include "pt-unop.h" +#include "pt-pr-code.h" +#include "pt-walk.h" + +// Prefix expressions. + +octave_value_list +tree_prefix_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("prefix operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_prefix_expression::rvalue (void) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op) + { + if (etype == unot || etype == uminus) + { + octave_value val = op->rvalue (); + + if (! error_state) + { + if (val.is_defined ()) + { + if (etype == unot) + retval = val.not (); + else + retval = val.uminus (); + } + else + error ("argument to prefix operator `%s' undefined", + oper () . c_str ()); + } + } + else if (etype == increment || etype == decrement) + { + octave_lvalue ref = op->lvalue (); + + if (! error_state) + { + if (ref.is_defined ()) + { + if (etype == increment) + ref.increment (); + else + ref.decrement (); + + retval = ref.value (); + } + else + error ("argument to prefix operator `%s' undefined", + oper () . c_str ()); + } + } + else + error ("prefix operator %d not implemented", etype); + } + + return retval; +} + +void +tree_prefix_expression::eval_error (void) +{ + if (error_state > 0) + ::error ("evaluating prefix operator `%s' near line %d, column %d", + oper () . c_str (), line (), column ()); +} + +string +tree_prefix_expression::oper (void) const +{ + string retval = "<unknown>"; + + switch (etype) + { + case unot: + retval = "!"; + break; + + case uminus: + retval = "-"; + break; + + case increment: + retval = "++"; + break; + + case decrement: + retval = "--"; + break; + + default: + break; + } + + return retval; +} + +void +tree_prefix_expression::accept (tree_walker& tw) +{ + tw.visit_prefix_expression (*this); +} + +// Postfix expressions. + +octave_value_list +tree_postfix_expression::rvalue (int nargout) +{ + octave_value_list retval; + + if (nargout > 1) + error ("postfix operator `%s': invalid number of output arguments", + oper () . c_str ()); + else + retval = rvalue (); + + return retval; +} + +octave_value +tree_postfix_expression::rvalue (void) +{ + octave_value retval; + + if (error_state) + return retval; + + if (op) + { + if (etype == transpose || etype == hermitian) + { + octave_value val = op->rvalue (); + + if (! error_state) + { + if (val.is_defined ()) + { + if (etype == transpose) + retval = val.transpose (); + else + retval = val.hermitian (); + } + else + error ("argument to postfix operator `%s' undefined", + oper () . c_str ()); + } + } + else if (etype == increment || etype == decrement) + { + octave_lvalue ref = op->lvalue (); + + if (! error_state) + { + if (ref.is_defined ()) + { + retval = ref.value (); + + if (etype == increment) + ref.increment (); + else + ref.decrement (); + } + else + error ("argument to postfix operator `%s' undefined", + oper () . c_str ()); + } + } + else + error ("postfix operator %d not implemented", etype); + } + + return retval; +} + +void +tree_postfix_expression::eval_error (void) +{ + if (error_state > 0) + ::error ("evaluating postfix operator `%s' near line %d, column %d", + oper () . c_str (), line (), column ()); +} + +string +tree_postfix_expression::oper (void) const +{ + string retval = "<unknown>"; + + switch (etype) + { + case transpose: + retval = ".'"; + break; + + case hermitian: + retval = "'"; + break; + + case increment: + retval = "++"; + break; + + case decrement: + retval = "--"; + break; + + default: + break; + } + + return retval; +} + +void +tree_postfix_expression::accept (tree_walker& tw) +{ + tw.visit_postfix_expression (*this); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/pt-unop.h @@ -0,0 +1,157 @@ +/* + +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_unop_h) +#define octave_tree_unop_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <string> + +class tree_walker; + +class octave_value; +class octave_value_list; +class octave_lvalue; + +#include "pt-exp.h" + +// Unary expressions. + +class +tree_unary_expression : public tree_expression +{ +public: + + tree_unary_expression (int l = -1, int c = -1) + : tree_expression (l, c), op (0) { } + + tree_unary_expression (tree_expression *e, int l = -1, int c = -1) + : tree_expression (l, c), op (e) { } + + ~tree_unary_expression (void) { delete op; } + + tree_expression *operand (void) { return op; } + +protected: + + // The operand for the expression. + tree_expression *op; +}; + +// Prefix expressions. + +class +tree_prefix_expression : public tree_unary_expression +{ +public: + + enum type + { + unknown, + unot, + uminus, + increment, + decrement + }; + + tree_prefix_expression (int l = -1, int c = -1) + : tree_unary_expression (l, c), etype (unknown) { } + + tree_prefix_expression (type t = unknown, tree_expression *e, + int l = -1, int c = -1) + : tree_unary_expression (e, l, c), etype (t) { } + + ~tree_prefix_expression (void) { } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargou); + + void eval_error (void); + + string oper (void) const; + + void accept (tree_walker& tw); + +private: + + // The type of the expression. + type etype; +}; + +// Postfix expressions. + +class +tree_postfix_expression : public tree_unary_expression +{ +public: + + enum type + { + unknown, + hermitian, + transpose, + increment, + decrement + }; + + tree_postfix_expression (int l = -1, int c = -1) + : tree_unary_expression (l, c), etype (unknown) { } + + tree_postfix_expression (type t = unknown, tree_expression *e, + int l = -1, int c = -1) + : tree_unary_expression (e, l, c), etype (t) { } + + ~tree_postfix_expression (void) { } + + bool rvalue_ok (void) const + { return true; } + + octave_value rvalue (void); + + octave_value_list rvalue (int nargout); + + void eval_error (void); + + string oper (void) const; + + void accept (tree_walker& tw); + +private: + + // The type of the expression. + type etype; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/