view src/pt-mvr.cc @ 2942:026f342c2019

[project @ 1997-05-08 02:20:57 by jwe]
author jwe
date Thu, 08 May 1997 02:28:50 +0000
parents 5ed088015839
children 6744ac301eef
line wrap: on
line source

/*

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 "str-vec.h"

#include "error.h"
#include "oct-obj.h"
#include "pager.h"
#include "pt-const.h"
#include "pt-exp.h"
#include "pt-id.h"
#include "pt-indir.h"
#include "pt-misc.h"
#include "pt-mvr.h"
#include "pt-walk.h"

// But first, some extra functions used by the tree classes.

// Make sure that all arguments have values.

static bool
all_args_defined (const octave_value_list& args)
{
  int nargin = args.length ();

  for (int i = 0; i < nargin; i++)
    if (args(i).is_undefined ())
      return false;

  return true;
}

// Used internally.

octave_value
tree_oct_obj::eval (bool /* print */)
{
  return values(0);
}

octave_value_list
tree_oct_obj::eval (bool, int, const octave_value_list&)
{
  return values;
}

void
tree_oct_obj::accept (tree_walker& tw)
{
  tw.visit_oct_obj (*this);
}

// Index expressions.

tree_index_expression::tree_index_expression
  (tree_identifier *i, int l = -1, int c = -1)
    : tree_multi_val_ret (l, c), id (new tree_indirect_ref (i)),
      list (0), arg_nm ()
{
}

tree_index_expression::tree_index_expression
  (tree_identifier *i, tree_argument_list *lst, int l = -1, int c = -1)
    : tree_multi_val_ret (l, c), id (new tree_indirect_ref (i)),
      list (lst), arg_nm ()
{
  if (list)
    arg_nm = list->get_arg_names ();
}

tree_index_expression::~tree_index_expression (void)
{
  delete id;
  delete list;
}

string
tree_index_expression::name (void) const
{
  return id->name ();
}

void
tree_index_expression::mark_for_possible_ans_assign (void)
{
  if (id)
    id->mark_for_possible_ans_assign ();
}

octave_value
tree_index_expression::eval (bool print)
{
  octave_value retval;

  if (error_state)
    return retval;

  if (list)
    {
      // Extract the arguments into a simple vector.  Don't pass null
      // args.

      octave_value_list args = list->convert_to_const_vector ();

      args.stash_name_tags (arg_nm);

      if (error_state)
	eval_error ();
      else
	{
	  if (error_state)
	    eval_error ();
	  else
	    {
	      if (all_args_defined (args))
		{
		  octave_value_list tmp = id->eval (print, 1, args);

		  if (error_state)
		    eval_error ();
		  else if (tmp.length () > 0)
		    retval = tmp(0);
		}
	      else
		{
		  ::error ("undefined arguments found in index expression");
		  eval_error ();
		}
	    }
	}
    }
  else
    {
      retval = id->eval (print);

      if (error_state)
	eval_error ();
    }

  return retval;
}

octave_value_list
tree_index_expression::eval (bool print, int nargout, const octave_value_list&)
{
  octave_value_list retval;

  if (error_state)
    return retval;

  if (list)
    {
      // Extract the arguments into a simple vector.  Don't pass null
      // args.

      octave_value_list tmp_args = list->convert_to_const_vector ();

      if (error_state)
	eval_error ();
      else
	{
	  if (error_state)
	    eval_error ();
	  else
	    {
	      if (all_args_defined (tmp_args))
		{
		  retval = id->eval (print, nargout, tmp_args);

		  if (error_state)
		    eval_error ();
		}
	      else
		{
		  ::error ("undefined arguments found in index expression");
		  eval_error ();
		}
	    }
	}
    }
  else
    {
      octave_value_list tmp_args;

      retval = id->eval (print, nargout, tmp_args);

      if (error_state)
	eval_error ();
    }

  return retval;
}

void
tree_index_expression::eval_error (void)
{
  if (error_state > 0)
    {
      int l = line ();
      int c = column ();
      const char *fmt;
      if (l != -1 && c != -1)
	{
	  if (list)
	    fmt = "evaluating index expression near line %d, column %d";
	  else
	    fmt = "evaluating expression near line %d, column %d";

	  ::error (fmt, 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);
}

// Multi-valued assignmnt expressions.

tree_multi_assignment_expression::~tree_multi_assignment_expression (void)
{
  if (! preserve)
    delete lhs;

  delete rhs;
}

octave_value
tree_multi_assignment_expression::eval (bool print)
{
  octave_value retval;

  if (error_state)
    return retval;

  octave_value_list tmp_args;
  octave_value_list result = eval (print, 1, tmp_args);

  if (result.length () > 0)
    retval = result(0);

  return retval;
}

octave_value_list
tree_multi_assignment_expression::eval (bool print, int nargout,
					const octave_value_list&)
{
  assert (etype == tree_expression::multi_assignment);

  if (error_state || ! rhs)
    return octave_value_list ();

  nargout = lhs->length ();
  octave_value_list tmp_args;
  octave_value_list results = rhs->eval (false, nargout, tmp_args);

  if (error_state)
    eval_error ();

  int ma_line = line ();
  int ma_column = column ();

  if (results.length () > 0)
    {
      int i = 0;

      bool pad_after = false;

      for (Pix p = lhs->first (); p != 0; lhs->next (p))
	{
	  tree_index_expression *lhs_expr = lhs->operator () (p);

	  if (i < nargout)
	    {
	      // XXX FIXME? XXX -- this is apparently the way Matlab
	      // works, but maybe we should have the option of
	      // skipping the assignment instead.

	      tree_constant *tmp = 0;
	      if (results(i).is_undefined ())
		{
		  error ("element number %d undefined in return list", i+1);
		  eval_error ();
		  break;
		}
	      else
		tmp = new tree_constant (results(i));

	      tree_simple_assignment_expression tmp_expr
		(lhs_expr, tmp, 1, 0, ma_line, ma_column);

	      results(i) = tmp_expr.eval (); // May change

	      if (error_state)
		break;

	      if (print && pad_after)
		octave_stdout << "\n";

	      if (print)
		results(i).print_with_name (octave_stdout,
					    lhs_expr->name (), 0);

	      pad_after = true;

	      i++;
	    }
	  else
	    {
	      tree_simple_assignment_expression tmp_expr
		(lhs_expr, 0, 1, 0, ma_line, ma_column);

	      tmp_expr.eval ();
	    }
	}

      if (print && pad_after)
	octave_stdout << "\n";
    }

  return results;
}

void
tree_multi_assignment_expression::eval_error (void)
{
  if (error_state > 0)
    ::error ("evaluating assignment expression near line %d, column %d",
	     line (), column ());
}

void
tree_multi_assignment_expression::accept (tree_walker& tw)
{
  tw.visit_multi_assignment_expression (*this);
}

/*
;;; Local Variables: ***
;;; mode: C++ ***
;;; End: ***
*/