/*

Copyright (C) 2009 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 3 of the License, 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, see

<http://www.gnu.org/licenses/>.

*/

#ifdef HAVE_CONFIG_H

#include <config.h>

#endif

#include <cctype>

#include <iostream>

#include <fstream>

#include <typeinfo>

#include "defun.h"

#include "error.h"

#include "gripes.h"

#include "input.h"

#include "ov-fcn-handle.h"

#include "ov-usr-fcn.h"

#include "variables.h"

#include "pt-all.h"

#include "pt-eval.h"

#include "symtab.h"

#include "unwind-prot.h"

static tree_evaluator std_evaluator;

tree_evaluator *current_evaluator = &std_evaluator;

int tree_evaluator::dbstep_flag = 0;

size_t tree_evaluator::current_frame = 0;

bool tree_evaluator::debug_mode = false;

bool tree_evaluator::in_fcn_or_script_body = false;

bool tree_evaluator::in_loop_command = false;

int tree_evaluator::db_line = -1;

int tree_evaluator::db_column = -1;

// If TRUE, turn off printing of results in functions (as if a

// semicolon has been appended to each statement).

static bool Vsilent_functions = false;

// Normal evaluator.

void

tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_argument_list (tree_argument_list&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_binary_expression (tree_binary_expression&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_break_command (tree_break_command& cmd)

{

  if (! error_state)

    {

      if (debug_mode)

	do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

      tree_break_command::breaking = 1;

    }

}

void

tree_evaluator::visit_colon_expression (tree_colon_expression&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_continue_command (tree_continue_command&)

{

  if (! error_state)

    tree_continue_command::continuing = 1;

}

static inline void

do_global_init (tree_decl_elt& elt)

{

  tree_identifier *id = elt.ident ();

  if (id)

    {

      id->mark_global ();

      if (! error_state)

	{

	  octave_lvalue ult = id->lvalue ();

	  if (ult.is_undefined ())

	    {

	      tree_expression *expr = elt.expression ();

	      octave_value init_val;

	      if (expr)

		init_val = expr->rvalue1 ();

	      else

		init_val = Matrix ();

	      ult.assign (octave_value::op_asn_eq, init_val);

	    }

	}

    }

}

static inline void

do_static_init (tree_decl_elt& elt)

{

  tree_identifier *id = elt.ident ();

  if (id)

    {

      id->mark_as_static ();

      octave_lvalue ult = id->lvalue ();

      if (ult.is_undefined ())

	{

	  tree_expression *expr = elt.expression ();

	  octave_value init_val;

	  if (expr)

	    init_val = expr->rvalue1 ();

	  else

	    init_val = Matrix ();

	  ult.assign (octave_value::op_asn_eq, init_val);

	}

    }

}

void

tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn,

				   tree_decl_init_list *init_list)

{

  if (init_list)

    {

      for (tree_decl_init_list::iterator p = init_list->begin ();

	   p != init_list->end (); p++)

	{

	  tree_decl_elt *elt = *p;

	  fcn (*elt);

	  if (error_state)

	    break;

	}

    }

}

void

tree_evaluator::visit_global_command (tree_global_command& cmd)

{

  if (debug_mode)

    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  do_decl_init_list (do_global_init, cmd.initializer_list ());

}

void

tree_evaluator::visit_static_command (tree_static_command& cmd)

{

  if (debug_mode)

    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  do_decl_init_list (do_static_init, cmd.initializer_list ());

}

void

tree_evaluator::visit_decl_elt (tree_decl_elt&)

{

  panic_impossible ();

}

#if 0

bool

tree_decl_elt::eval (void)

{

  bool retval = false;

  if (id && expr)

    {

      octave_lvalue ult = id->lvalue ();

      octave_value init_val = expr->rvalue1 ();

      if (! error_state)

       {

         ult.assign (octave_value::op_asn_eq, init_val);

         retval = true;

       }

    }

  return retval;

}

#endif

void

tree_evaluator::visit_decl_init_list (tree_decl_init_list&)

{

  panic_impossible ();

}

// Decide if it's time to quit a for or while loop.

static inline bool

quit_loop_now (void)

{

  OCTAVE_QUIT;

  // Maybe handle `continue N' someday...

  if (tree_continue_command::continuing)

    tree_continue_command::continuing--;

  bool quit = (error_state

	       || tree_return_command::returning

	       || tree_break_command::breaking

	       || tree_continue_command::continuing);

  if (tree_break_command::breaking)

    tree_break_command::breaking--;

  return quit;

}

#define DO_SIMPLE_FOR_LOOP_ONCE(VAL) \

  do \

    { \

      ult.assign (octave_value::op_asn_eq, VAL); \

 \

      if (! error_state && loop_body) \

	loop_body->accept (*this); \

 \

      quit = quit_loop_now (); \

    } \

  while (0)

void

tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd)

{

  if (error_state)

    return;

  if (debug_mode)

    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  unwind_protect::begin_frame ("tree_evaluator::visit_simple_for_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

  if (error_state || rhs.is_undefined ())

    goto cleanup;

  {

    tree_expression *lhs = cmd.left_hand_side ();

    octave_lvalue ult = lhs->lvalue ();

    if (error_state)

      goto cleanup;

    tree_statement_list *loop_body = cmd.body ();

    if (rhs.is_range ())

      {

	Range rng = rhs.range_value ();

	octave_idx_type steps = rng.nelem ();

	double b = rng.base ();

	double increment = rng.inc ();

	bool quit = false;

	for (octave_idx_type i = 0; i < steps; i++)

	  {

	    // Use multiplication here rather than declaring a

	    // temporary variable outside the loop and using

	    //

	    //   tmp_val += increment

	    //

	    // to avoid problems with limited precision.  Also, this

	    // is consistent with the way Range::matrix_value is

	    // implemented.

	    octave_value val (b + i * increment);

	    DO_SIMPLE_FOR_LOOP_ONCE (val);

	    if (quit)

	      break;

	  }

      }

    else if (rhs.is_scalar_type ())

      {

	bool quit = false;

	DO_SIMPLE_FOR_LOOP_ONCE (rhs);

      }

    else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string ()

             || rhs.is_map ())

      {

        // A matrix or cell is reshaped to 2 dimensions and iterated by

        // columns.

        bool quit = false;

        dim_vector dv = rhs.dims ().redim (2);

        octave_idx_type nrows = dv(0), steps = dv(1);

        if (steps > 0)

          {

            octave_value arg = rhs;

            if (rhs.ndims () > 2)

              arg = arg.reshape (dv);

            // for row vectors, use single index to speed things up.

            octave_value_list idx;

            octave_idx_type iidx;

            if (nrows == 1)

              {

                idx.resize (1);

                iidx = 0;

              }

            else

              {

                idx.resize (2);

                idx(0) = octave_value::magic_colon_t;

                iidx = 1;

              }

            for (octave_idx_type i = 1; i <= steps; i++)

              {

                // do_index_op expects one-based indices.

                idx(iidx) = i;

                octave_value val = arg.do_index_op (idx);

                DO_SIMPLE_FOR_LOOP_ONCE (val);

                if (quit)

                  break;

              }

          }

      }

    else

      {

	::error ("invalid type in for loop expression near line %d, column %d",

		 cmd.line (), cmd.column ());

      }

  }

 cleanup:

  unwind_protect::run_frame ("tree_evaluator::visit_simple_for_command");

}

void

tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd)

{

  if (error_state)

    return;

  if (debug_mode)

    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  unwind_protect::begin_frame ("tree_evaluator::visit_complex_for_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

  if (error_state || rhs.is_undefined ())

    goto cleanup;

  if (rhs.is_map ())

    {

      // Cycle through structure elements.  First element of id_list

      // is set to value and the second is set to the name of the

      // structure element.

      tree_argument_list *lhs = cmd.left_hand_side ();

      tree_argument_list::iterator p = lhs->begin ();

      tree_expression *elt = *p++;

      octave_lvalue val_ref = elt->lvalue ();

      elt = *p;

      octave_lvalue key_ref = elt->lvalue ();

      const Octave_map tmp_val (rhs.map_value ());

      tree_statement_list *loop_body = cmd.body ();

      for (Octave_map::const_iterator q = tmp_val.begin (); q != tmp_val.end (); q++)

	{

	  octave_value key = tmp_val.key (q);

	  const Cell val_lst = tmp_val.contents (q);

	  octave_idx_type n = tmp_val.numel ();

	  octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst);

	  val_ref.assign (octave_value::op_asn_eq, val);

	  key_ref.assign (octave_value::op_asn_eq, key);

	  if (! error_state && loop_body)

	    loop_body->accept (*this);

	  if (quit_loop_now ())

	    break;

	}

    }

  else

    error ("in statement `for [X, Y] = VAL', VAL must be a structure");

 cleanup:

  unwind_protect::run_frame ("tree_evaluator::visit_complex_for_command");

}

void

tree_evaluator::visit_octave_user_script (octave_user_script&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_octave_user_function (octave_user_function&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_octave_user_function_header (octave_user_function&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_octave_user_function_trailer (octave_user_function&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_function_def (tree_function_def& cmd)

{

  octave_value fcn = cmd.function ();

  octave_function *f = fcn.function_value ();

  if (f)

    {

      std::string nm = f->name ();

      symbol_table::install_cmdline_function (nm, fcn);

      // Make sure that any variable with the same name as the new

      // function is cleared.

      symbol_table::varref (nm) = octave_value ();

    }

}

void

tree_evaluator::visit_identifier (tree_identifier&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_if_clause (tree_if_clause&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_if_command (tree_if_command& cmd)

{

  tree_if_command_list *lst = cmd.cmd_list ();

  if (lst)

    lst->accept (*this);

}

void

tree_evaluator::visit_if_command_list (tree_if_command_list& lst)

{

  for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++)

    {

      tree_if_clause *tic = *p;

      tree_expression *expr = tic->condition ();

      if (debug_mode && ! tic->is_else_clause ())

	do_breakpoint (tic->is_breakpoint (), tic->line (), tic->column ());

      if (tic->is_else_clause () || expr->is_logically_true ("if"))

	{

	  if (! error_state)

	    {

	      tree_statement_list *stmt_lst = tic->commands ();

	      if (stmt_lst)

		stmt_lst->accept (*this);

	    }

	  break;

	}

    }

}

void

tree_evaluator::visit_index_expression (tree_index_expression&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_matrix (tree_matrix&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_cell (tree_cell&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_multi_assignment (tree_multi_assignment&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_no_op_command (tree_no_op_command& cmd)

{

  if (debug_mode && cmd.is_end_of_fcn_or_script ())

    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column (), true);

}

void

tree_evaluator::visit_constant (tree_constant&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_fcn_handle (tree_fcn_handle&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_parameter_list (tree_parameter_list&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_postfix_expression (tree_postfix_expression&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_prefix_expression (tree_prefix_expression&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_return_command (tree_return_command& cmd)

{

  if (! error_state)

    {

      if (debug_mode)

	do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

      tree_return_command::returning = 1;

    }

}

void

tree_evaluator::visit_return_list (tree_return_list&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_simple_assignment (tree_simple_assignment&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_statement (tree_statement& stmt)

{

  tree_command *cmd = stmt.command ();

  tree_expression *expr = stmt.expression ();

  if (cmd || expr)

    {

      if (in_fcn_or_script_body)

	{

	  octave_call_stack::set_statement (&stmt);

	  if (Vecho_executing_commands & ECHO_FUNCTIONS)

	    stmt.echo_code ();

	}

      try

	{

	  if (cmd)

	    cmd->accept (*this);

	  else

	    {

	      if (debug_mode)

		do_breakpoint (expr->is_breakpoint (), expr->line (),

			       expr->column ());

	      if (in_fcn_or_script_body && Vsilent_functions)

		expr->set_print_flag (false);

	      // FIXME -- maybe all of this should be packaged in

	      // one virtual function that returns a flag saying whether

	      // or not the expression will take care of binding ans and

	      // printing the result.

	      // FIXME -- it seems that we should just have to

	      // call expr->rvalue1 () and that should take care of

	      // everything, binding ans as necessary?

	      bool do_bind_ans = false;

	      if (expr->is_identifier ())

		{

		  tree_identifier *id = dynamic_cast<tree_identifier *> (expr);

		  do_bind_ans = (! id->is_variable ());

		}

	      else

		do_bind_ans = (! expr->is_assignment_expression ());

	      octave_value tmp_result = expr->rvalue1 (0);

	      if (do_bind_ans && ! (error_state || tmp_result.is_undefined ()))

		bind_ans (tmp_result, expr->print_result ());

	      //	      if (tmp_result.is_defined ())

	      //		result_values(0) = tmp_result;

	    }

	}

      catch (octave_execution_exception)

	{

	  gripe_library_execution_error ();

	}

    }

}

void

tree_evaluator::visit_statement_list (tree_statement_list& lst)

{

  static octave_value_list empty_list;

  if (error_state)

    return;

  tree_statement_list::iterator p = lst.begin ();

  if (p != lst.end ())

    {

      while (true)

	{

	  tree_statement *elt = *p++;

	  if (elt)

	    {

	      OCTAVE_QUIT;

	      elt->accept (*this);

	      if (error_state)

		break;

	      if (tree_break_command::breaking

		  || tree_continue_command::continuing)

		break;

	      if (tree_return_command::returning)

		break;

	      if (p == lst.end ())

		break;

	      else

		{

		  // Clear preivous values before next statement is

		  // evaluated so that we aren't holding an extra

		  // reference to a value that may be used next.  For

		  // example, in code like this:

		  //

		  //   X = rand (N);  ## refcount for X should be 1

		  //                  ## after this statement

		  //

		  //   X(idx) = val;  ## no extra copy of X should be

		  //                  ## needed, but we will be faked

		  //                  ## out if retval is not cleared

		  //                  ## between statements here

		  //		  result_values = empty_list;

		}

	    }

	  else

	    error ("invalid statement found in statement list!");

	}

    }

}

void

tree_evaluator::visit_switch_case (tree_switch_case&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_switch_case_list (tree_switch_case_list&)

{

  panic_impossible ();

}

void

tree_evaluator::visit_switch_command (tree_switch_command& cmd)

{

  tree_expression *expr = cmd.switch_value ();

  if (expr)

    {

      octave_value val = expr->rvalue1 ();

      tree_switch_case_list *lst = cmd.case_list ();

      if (! error_state && lst)

	{

	  for (tree_switch_case_list::iterator p = lst->begin ();

	       p != lst->end (); p++)

	    {

	      tree_switch_case *t = *p;

	      if (debug_mode && ! t->is_default_case ())

		do_breakpoint (t->is_breakpoint (), t->line (), t->column ());

	      if (t->is_default_case () || t->label_matches (val))

		{

		  if (error_state)

		    break;

		  tree_statement_list *stmt_lst = t->commands ();

		  if (stmt_lst)

		    stmt_lst->accept (*this);

		  break;

		}

	    }

	}

    }

  else

    ::error ("missing value in switch command near line %d, column %d",

	     cmd.line (), cmd.column ());

}

static void

do_catch_code (void *ptr)

{

  // Is it safe to call OCTAVE_QUIT here?  We are already running

  // something on the unwind_protect stack, but the element for this

  // action would have already been popped from the top of the stack,

  // so we should not be attempting to run it again.

  OCTAVE_QUIT;

  // If we are interrupting immediately, or if an interrupt is in

  // progress (octave_interrupt_state < 0), then we don't want to run

  // the catch code (it should only run on errors, not interrupts).

  // If octave_interrupt_state is positive, an interrupt is pending.

  // The only way that could happen would be for the interrupt to

  // come in after the OCTAVE_QUIT above and before the if statement

  // below -- it's possible, but unlikely.  In any case, we should

  // probably let the catch code throw the exception because we don't

  // want to skip that and potentially run some other code.  For

  // example, an error may have originally brought us here for some

  // cleanup operation and we shouldn't skip that.

  if (octave_interrupt_immediately || octave_interrupt_state < 0)

    return;

  tree_statement_list *list = static_cast<tree_statement_list *> (ptr);

  // Set up for letting the user print any messages from errors that

  // occurred in the body of the try_catch statement.

  buffer_error_messages--;

  if (list)

    list->accept (*current_evaluator);

}

void

tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd)

{

  unwind_protect::begin_frame ("tree_evaluator::visit_try_catch_command");

  unwind_protect_int (buffer_error_messages);

  unwind_protect_bool (Vdebug_on_error);

  unwind_protect_bool (Vdebug_on_warning);

  buffer_error_messages++;

  Vdebug_on_error = false;

  Vdebug_on_warning = false;

  tree_statement_list *catch_code = cmd.cleanup ();

  unwind_protect::add (do_catch_code, catch_code);

  tree_statement_list *try_code = cmd.body ();

  if (try_code)

    try_code->accept (*this);

  if (catch_code && error_state)

    {

      error_state = 0;

      unwind_protect::run_frame ("tree_evaluator::visit_try_catch_command");

    }

  else

    {

      error_state = 0;

      // Unwind stack elements must be cleared or run in the reverse

      // order in which they were added to the stack.

      // For clearing the do_catch_code cleanup function.

      unwind_protect::discard ();

      // For restoring Vdebug_on_warning, Vdebug_on_error, and

      // buffer_error_messages.

      unwind_protect::run ();

      unwind_protect::run ();

      unwind_protect::run ();

      // Also clear the frame marker.

      unwind_protect::discard ();

    }

}

void restore_interrupt_state (void *ptr)

{

  octave_interrupt_state = *(reinterpret_cast<sig_atomic_t *> (ptr));

}

static void

do_unwind_protect_cleanup_code (void *ptr)

{

  tree_statement_list *list = static_cast<tree_statement_list *> (ptr);

  sig_atomic_t saved_octave_interrupt_state = octave_interrupt_state;

  unwind_protect::add (restore_interrupt_state, &saved_octave_interrupt_state);

  octave_interrupt_state = 0;

  // We want to run the cleanup code without error_state being set,

  // but we need to restore its value, so that any errors encountered

  // in the first part of the unwind_protect are not completely

  // ignored.

  unwind_protect_int (error_state);

  error_state = 0;

  // Similarly, if we have seen a return or break statement, allow all

  // the cleanup code to run before returning or handling the break.

  // We don't have to worry about continue statements because they can

  // only occur in loops.

  unwind_protect_int (tree_return_command::returning);

  tree_return_command::returning = 0;

  unwind_protect_int (tree_break_command::breaking);

  tree_break_command::breaking = 0;

  if (list)

    list->accept (*current_evaluator);

  // The unwind_protects are popped off the stack in the reverse of

  // the order they are pushed on.

  // FIXME -- these statements say that if we see a break or

  // return statement in the cleanup block, that we want to use the

  // new value of the breaking or returning flag instead of restoring

  // the previous value.  Is that the right thing to do?  I think so.

  // Consider the case of

  //

  //   function foo ()

  //     unwind_protect

  //       stderr << "1: this should always be executed\n";

  //       break;

  //       stderr << "1: this should never be executed\n";

  //     unwind_protect_cleanup

  //       stderr << "2: this should always be executed\n";

  //       return;

  //       stderr << "2: this should never be executed\n";

  //     end_unwind_protect

  //   endfunction

  //

  // If we reset the value of the breaking flag, both the returning

  // flag and the breaking flag will be set, and we shouldn't have

  // both.  So, use the most recent one.  If there is no return or

  // break in the cleanup block, the values should be reset to

  // whatever they were when the cleanup block was entered.

  if (tree_break_command::breaking || tree_return_command::returning)

    {

      unwind_protect::discard ();

      unwind_protect::discard ();

    }

  else

    {

      unwind_protect::run ();

      unwind_protect::run ();

    }

  // We don't want to ignore errors that occur in the cleanup code, so

  // if an error is encountered there, leave error_state alone.

  // Otherwise, set it back to what it was before.

  if (error_state)

    unwind_protect::discard ();

  else

    unwind_protect::run ();

  unwind_protect::run ();

}

void

tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd)