diff src/ov.cc @ 2376:2142216bf85a

[project @ 1996-10-12 01:39:07 by jwe]
author jwe
date Sat, 12 Oct 1996 01:39:21 +0000
parents
children 47e5f57fb4bd
line wrap: on
line diff
new file mode 100644
--- /dev/null
+++ b/src/ov.cc
@@ -0,0 +1,745 @@
+/*
+
+Copyright (C) 1996 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 "Array-flags.h"
+
+#include "ov.h"
+#include "ov-base.h"
+#include "ov-scalar.h"
+#include "ov-re-mat.h"
+#include "ov-complex.h"
+#include "ov-cx-mat.h"
+#include "ov-ch-mat.h"
+#include "ov-str-mat.h"
+#include "ov-range.h"
+#include "ov-struct.h"
+#include "ov-colon.h"
+#include "ov-va-args.h"
+#include "ov-typeinfo.h"
+
+#include "defun.h"
+#include "gripes.h"
+#include "pager.h"
+#include "pr-output.h"
+#include "utils.h"
+#include "variables.h"
+
+// If TRUE, allow assignments like
+//
+//   octave> A(1) = 3; A(2) = 5
+//
+// for A already defined and a matrix type.
+bool Vdo_fortran_indexing;
+
+// Should we allow things like:
+//
+//   octave> 'abc' + 0
+//   97 98 99
+//
+// to happen?  A positive value means yes.  A negative value means
+// yes, but print a warning message.  Zero means it should be
+// considered an error.
+int Vimplicit_str_to_num_ok;
+
+// Should we allow silent conversion of complex to real when a real
+// type is what we're really looking for?  A positive value means yes.
+// A negative value means yes, but print a warning message.  Zero
+// means it should be considered an error.
+int Vok_to_lose_imaginary_part;
+
+// If TRUE, create column vectors when doing assignments like:
+//
+//   octave> A(1) = 3; A(2) = 5
+//
+// (for A undefined).  Only matters when resize_on_range_error is also
+// TRUE.
+bool Vprefer_column_vectors;
+
+// If TRUE, prefer logical (zore-one) indexing over normal indexing
+// when there is a conflice.  For example, given a = [2, 3], the
+// expression  a ([1, 1]) would return [2 3] (instead of [2 2], which
+// would be returned if prefer_zero_one_indxing were FALSE).
+bool Vprefer_zero_one_indexing;
+
+// If TRUE, print the name along with the value.
+bool Vprint_answer_id_name;
+
+// Should operations on empty matrices return empty matrices or an
+// error?  A positive value means yes.  A negative value means yes,
+// but print a warning message.  Zero means it should be considered an
+// error.
+int Vpropagate_empty_matrices;
+
+// If TRUE, resize matrices when performing and indexed assignment and
+// the indices are outside the current bounds.
+bool Vresize_on_range_error;
+
+// How many levels of structure elements should we print?
+int Vstruct_levels_to_print;
+
+// Allow divide by zero errors to be suppressed.
+bool Vwarn_divide_by_zero;
+
+// Indentation level for structures.
+int struct_indent = 0;
+
+// XXX FIXME XXX
+void
+increment_struct_indent (void)
+{
+  struct_indent += 2;
+}
+
+void
+decrement_struct_indent (void)
+{
+  struct_indent -= 2;
+}
+
+// Octave's value type.
+
+string
+octave_value::binary_op_as_string (binary_op op)
+{
+  string retval;
+
+  switch (op)
+    {
+    case add:
+      retval = "+";
+      break;
+
+    case sub:
+      retval = "-";
+      break;
+
+    case mul:
+      retval = "*";
+      break;
+
+    case div:
+      retval = "/";
+      break;
+
+    case pow:
+      retval = "^";
+      break;
+
+    case ldiv:
+      retval = "\\";
+      break;
+
+    case lt:
+      retval = "<";
+      break;
+
+    case le:
+      retval = "<=";
+      break;
+
+    case eq:
+      retval = "==";
+      break;
+
+    case ge:
+      retval = ">=";
+      break;
+
+    case gt:
+      retval = ">";
+      break;
+
+    case ne:
+      retval = "!=";
+      break;
+
+    case el_mul:
+      retval = ".*";
+      break;
+
+    case el_div:
+      retval = "./";
+      break;
+
+    case el_pow:
+      retval = ".^";
+      break;
+
+    case el_ldiv:
+      retval = ".\\";
+      break;
+
+    case el_and:
+      retval = "&";
+      break;
+
+    case el_or:
+      retval = "|";
+      break;
+
+    case struct_ref:
+      retval = ".";
+      break;
+
+    default:
+      retval = "<unknown>";
+    }
+
+  return retval;
+}
+
+octave_value::octave_value (void)
+  : rep (new octave_base_value ()) { rep->count = 1; }
+
+octave_value::octave_value (double d)
+  : rep (new octave_scalar (d)) { rep->count = 1; }
+
+octave_value::octave_value (const Matrix& m)
+  : rep (new octave_matrix (m)) { rep->count = 1; }
+
+octave_value::octave_value (const DiagMatrix& d)
+  : rep (new octave_matrix (d)) { rep->count = 1; }
+
+octave_value::octave_value (const RowVector& v, int pcv)
+  : rep (new octave_matrix (v, pcv)) { rep->count = 1; }
+
+octave_value::octave_value (const ColumnVector& v, int pcv)
+  : rep (new octave_matrix (v, pcv)) { rep->count = 1; }
+
+octave_value::octave_value (const Complex& C)
+  : rep (new octave_complex (C)) { rep->count = 1; }
+
+octave_value::octave_value (const ComplexMatrix& m)
+  : rep (new octave_complex_matrix (m)) { rep->count = 1; }
+
+octave_value::octave_value (const ComplexDiagMatrix& d)
+  : rep (new octave_complex_matrix (d)) { rep->count = 1; }
+
+octave_value::octave_value (const ComplexRowVector& v, int pcv)
+  : rep (new octave_complex_matrix (v, pcv)) { rep->count = 1; }
+
+octave_value::octave_value (const ComplexColumnVector& v, int pcv)
+  : rep (new octave_complex_matrix (v, pcv)) { rep->count = 1; }
+
+octave_value::octave_value (const char *s)
+  : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
+
+octave_value::octave_value (const string& s)
+  : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
+
+octave_value::octave_value (const string_vector& s)
+  : rep (new octave_char_matrix_str (s)) { rep->count = 1; }
+
+octave_value::octave_value (const charMatrix& chm, bool is_string)
+  {
+    if (is_string)
+      rep = new octave_char_matrix_str (chm);
+    else
+      rep = new octave_char_matrix (chm);
+
+    rep->count = 1;
+  }
+
+octave_value::octave_value (double base, double limit, double inc)
+  : rep (new octave_range (base, limit, inc)) { rep->count = 1; }
+
+octave_value::octave_value (const Range& r)
+  : rep (new octave_range (r)) { rep->count = 1; }
+
+octave_value::octave_value (const Octave_map& m)
+  : rep (new octave_struct (m)) { rep->count = 1; }
+
+octave_value::octave_value (octave_value::magic_colon)
+  : rep (new octave_magic_colon ()) { rep->count = 1; }
+
+octave_value::octave_value (octave_value::all_va_args)
+  : rep (new octave_all_va_args ()) { rep->count = 1; }
+
+octave_value::octave_value (octave_value *new_rep)
+  : rep (new_rep) { rep->count = 1; }
+
+octave_value::~octave_value (void)
+{
+#if defined (MDEBUG)
+  cerr << "~octave_value: rep: " << rep
+       << " rep->count: " << rep->count << "\n";
+#endif
+
+  if (rep && --rep->count == 0)
+    {
+      delete rep;
+      rep = 0;
+    }
+}
+
+static void
+gripe_indexed_assignment (const string& tn1, const string& tn2)
+{
+  error ("assignment of %s to indexed %s not implemented",
+	 tn2.c_str (), tn1.c_str ());
+}
+
+static void
+gripe_no_conversion (const string& tn1, const string& tn2)
+{
+  error ("no suitable conversion found for assignment of %s to indexed %s",
+	 tn2.c_str (), tn1.c_str ());
+}
+
+static void
+gripe_conversion_failed (const string& tn1, const string& tn2)
+{
+  error ("type conversion for assignment of %s to indexed %s failed",
+	 tn2.c_str (), tn1.c_str ());
+}
+
+octave_value&
+octave_value::assign (const octave_value_list& idx, const octave_value& rhs)
+{
+  make_unique ();
+
+  int t_lhs = type_id ();
+  int t_rhs = rhs.type_id ();
+
+  octave_value::assign_op_fcn f
+    = octave_value_typeinfo::lookup_assign_op (t_lhs, t_rhs);
+
+  if (f)
+    f (*(this->rep), idx, *(rhs.rep));
+  else
+    {
+      int t_result
+	= octave_value_typeinfo::lookup_pref_assign_conv (t_lhs, t_rhs);
+
+      if (t_result >= 0)
+	{
+	  octave_value::widening_op_fcn wf
+	    = octave_value_typeinfo::lookup_widening_op (t_lhs, t_result);
+
+	  if (wf)
+	    {
+	      octave_value *tmp = wf (*(this->rep));
+
+	      if (tmp && tmp != rep)
+		{
+		  if (--rep->count == 0)
+		    delete rep;
+
+		  rep = tmp;
+		  rep->count = 1;
+
+		  t_lhs = type_id ();
+
+		  f = octave_value_typeinfo::lookup_assign_op (t_lhs, t_rhs);
+
+		  if (f)
+		    f (*(this->rep), idx, *(rhs.rep));
+		  else
+		    gripe_indexed_assignment (type_name (), rhs.type_name ());
+		}
+	      else
+		gripe_conversion_failed (type_name (), rhs.type_name ());
+	    }
+	  else
+	    gripe_indexed_assignment (type_name (), rhs.type_name ());
+	}
+      else
+	gripe_no_conversion (type_name (), rhs.type_name ());
+    }
+
+  return *this;
+}
+
+Octave_map
+octave_value::map_value (void) const
+{
+  return rep->map_value ();
+}
+
+ColumnVector
+octave_value::vector_value (bool force_string_conv,
+			    bool force_vector_conversion) const
+{
+  ColumnVector retval;
+
+  Matrix m = matrix_value (force_string_conv);
+
+  if (error_state)
+    return retval;
+
+  int nr = m.rows ();
+  int nc = m.columns ();
+
+  if (nr == 1)
+    {
+      retval.resize (nc);
+      for (int i = 0; i < nc; i++)
+	retval (i) = m (0, i);
+    }
+  else if (nc == 1)
+    {
+      retval.resize (nr);
+      for (int i = 0; i < nr; i++)
+	retval (i) = m (i, 0);
+    }
+  else if (nr > 0 && nc > 0
+	   && (Vdo_fortran_indexing || force_vector_conversion))
+    {
+      retval.resize (nr * nc);
+      int k = 0;
+      for (int j = 0; j < nc; j++)
+	for (int i = 0; i < nr; i++)
+	  retval (k++) = m (i, j);
+    }
+  else
+    {
+      string tn = type_name ();
+      gripe_invalid_conversion (tn.c_str (), "real vector");
+    }
+
+  return retval;
+}
+
+ComplexColumnVector
+octave_value::complex_vector_value (bool force_string_conv,
+				    bool force_vector_conversion) const
+{
+  ComplexColumnVector retval;
+
+  ComplexMatrix m = complex_matrix_value (force_string_conv);
+
+  if (error_state)
+    return retval;
+
+  int nr = m.rows ();
+  int nc = m.columns ();
+
+  if (nr == 1)
+    {
+      retval.resize (nc);
+      for (int i = 0; i < nc; i++)
+	retval (i) = m (0, i);
+    }
+  else if (nc == 1)
+    {
+      retval.resize (nr);
+      for (int i = 0; i < nr; i++)
+	retval (i) = m (i, 0);
+    }
+  else if (nr > 0 && nc > 0
+	   && (Vdo_fortran_indexing || force_vector_conversion))
+    {
+      retval.resize (nr * nc);
+      int k = 0;
+      for (int j = 0; j < nc; j++)
+	for (int i = 0; i < nr; i++)
+	  retval (k++) = m (i, j);
+    }
+  else
+    {
+      string tn = type_name ();
+      gripe_invalid_conversion (tn.c_str (), "complex vector");
+    }
+
+  return retval;
+}
+
+void
+octave_value::print (void)
+{
+  print (octave_stdout);
+}
+
+void
+octave_value::print_with_name (const string& name, bool print_padding)
+{
+  print_with_name (octave_stdout, name, print_padding);
+}
+
+void
+octave_value::print_with_name (ostream& output_buf, const string& name,
+			       bool print_padding) 
+{
+  bool pad_after = false;
+
+  if (Vprint_answer_id_name)
+    {
+      if (print_as_scalar ())
+	output_buf << name << " = ";
+      else if (print_as_structure ())
+	{
+	  pad_after = true;
+	  output_buf << name << " =";
+	}
+      else
+	{
+	  pad_after = true;
+	  output_buf << name << " =\n\n";
+	}
+    }
+
+  print (output_buf);
+
+  if (print_padding && pad_after)
+    output_buf << "\n";
+}
+
+bool
+octave_value::print_as_scalar (void)
+{
+  int nr = rows ();
+  int nc = columns ();
+
+  return (is_scalar_type ()
+	  || (is_string () && nr <= 1)
+	  || (is_matrix_type ()
+	      && ((nr == 1 && nc == 1)
+		  || nr == 0
+		  || nc == 0)));
+}
+
+static void
+gripe_binary_op (const string& on, const string& tn1, const string& tn2)
+{
+  error ("binary operator %s not implemented for %s by %s operations",
+	 on.c_str (), tn1.c_str (), tn2.c_str ());
+}
+
+octave_value
+do_binary_op (octave_value::binary_op op, const octave_value& v1,
+	      const octave_value& v2)
+{
+  octave_value retval;
+
+  int t1 = v1.type_id ();
+  int t2 = v2.type_id ();
+
+  octave_value::binary_op_fcn f
+    = octave_value_typeinfo::lookup_binary_op (op, t1, t2);
+
+  if (f)
+    retval = f (*v1.rep, *v2.rep);
+  else
+    {
+      octave_value tv1;
+      octave_value::numeric_conv_fcn cf1 = v1.numeric_conversion_function ();
+
+      if (cf1)
+	{
+	  tv1 = octave_value (cf1 (*v1.rep));
+	  t1 = tv1.type_id ();
+	}
+      else
+	tv1 = v1;
+
+      octave_value tv2;
+      octave_value::numeric_conv_fcn cf2 = v2.numeric_conversion_function ();
+
+      if (cf2)
+	{
+	  tv2 = octave_value (cf2 (*v2.rep));
+	  t2 = tv2.type_id ();
+	}
+      else
+	tv2 = v2;
+
+      if (cf1 || cf2)
+	{
+	  octave_value::binary_op_fcn f
+	    = octave_value_typeinfo::lookup_binary_op (op, t1, t2);
+
+	  if (f)
+	    retval = f (*tv1.rep, *tv2.rep);
+	  else
+	    gripe_binary_op (octave_value::binary_op_as_string (op),
+			     v1.type_name (), v2.type_name ());
+	}
+      else
+	gripe_binary_op (octave_value::binary_op_as_string (op),
+			 v1.type_name (), v2.type_name ());
+    }
+
+  return retval;
+}
+
+void
+install_types (void)
+{
+  octave_base_value::register_type ();
+  octave_scalar::register_type ();
+  octave_complex::register_type ();
+  octave_matrix::register_type ();
+  octave_complex_matrix::register_type ();
+  octave_range::register_type ();
+  octave_char_matrix::register_type ();
+  octave_char_matrix_str::register_type ();
+  octave_struct::register_type ();
+  octave_all_va_args::register_type ();
+  octave_magic_colon::register_type ();
+}
+
+static int
+do_fortran_indexing (void)
+{
+  Vdo_fortran_indexing = check_preference ("do_fortran_indexing");
+
+  liboctave_dfi_flag = Vdo_fortran_indexing;
+
+  return 0;
+}
+
+static int
+implicit_str_to_num_ok (void)
+{
+  Vimplicit_str_to_num_ok = check_preference ("implicit_str_to_num_ok");
+
+  return 0;
+}
+
+static int
+ok_to_lose_imaginary_part (void)
+{
+  Vok_to_lose_imaginary_part = check_preference ("ok_to_lose_imaginary_part");
+
+  return 0;
+}
+
+static int
+prefer_column_vectors (void)
+{
+  Vprefer_column_vectors
+    = check_preference ("prefer_column_vectors");
+
+  liboctave_pcv_flag = Vprefer_column_vectors;
+
+  return 0;
+}
+
+static int
+prefer_zero_one_indexing (void)
+{
+  Vprefer_zero_one_indexing = check_preference ("prefer_zero_one_indexing");
+
+  liboctave_pzo_flag = Vprefer_zero_one_indexing;
+
+  return 0;
+}
+
+static int
+print_answer_id_name (void)
+{
+  Vprint_answer_id_name = check_preference ("print_answer_id_name");
+
+  return 0;
+}
+
+static int
+propagate_empty_matrices (void)
+{
+  Vpropagate_empty_matrices = check_preference ("propagate_empty_matrices");
+
+  return 0;
+}
+
+static int
+resize_on_range_error (void)
+{
+  Vresize_on_range_error = check_preference ("resize_on_range_error");
+
+  liboctave_rre_flag = Vresize_on_range_error;
+
+  return 0;
+}
+
+static int
+struct_levels_to_print (void)
+{
+  double val;
+  if (builtin_real_scalar_variable ("struct_levels_to_print", val)
+      && ! xisnan (val))
+    {
+      int ival = NINT (val);
+      if (ival >= 0 && (double) ival == val)
+	{
+	  Vstruct_levels_to_print = ival;
+	  return 0;
+	}
+    }
+  gripe_invalid_value_specified ("struct_levels_to_print");
+  return -1;
+}
+
+static int
+warn_divide_by_zero (void)
+{
+  Vwarn_divide_by_zero = check_preference ("warn_divide_by_zero");
+
+  return 0;
+}
+
+void
+symbols_of_value (void)
+{
+  DEFVAR (do_fortran_indexing, 0.0, 0, do_fortran_indexing,
+    "allow single indices for matrices");
+
+  DEFVAR (implicit_str_to_num_ok, 0.0, 0, implicit_str_to_num_ok,
+    "allow implicit string to number conversion");
+
+  DEFVAR (ok_to_lose_imaginary_part, "warn", 0, ok_to_lose_imaginary_part,
+    "silently convert from complex to real by dropping imaginary part");
+
+  DEFVAR (prefer_column_vectors, 1.0, 0, prefer_column_vectors,
+    "prefer column/row vectors");
+
+  DEFVAR (prefer_zero_one_indexing, 0.0, 0, prefer_zero_one_indexing,
+    "when there is a conflict, prefer zero-one style indexing");
+
+  DEFVAR (print_answer_id_name, 1.0, 0, print_answer_id_name,
+    "set output style to print `var_name = ...'");
+
+  DEFVAR (propagate_empty_matrices, 1.0, 0, propagate_empty_matrices,
+    "operations on empty matrices return an empty matrix, not an error");
+
+  DEFVAR (resize_on_range_error, 1.0, 0, resize_on_range_error,
+    "enlarge matrices on assignment");
+
+  DEFVAR (struct_levels_to_print, 2.0, 0, struct_levels_to_print,
+    "number of levels of structure elements to print");
+
+  DEFVAR (warn_divide_by_zero, 1.0, 0, warn_divide_by_zero,
+    "If TRUE, warn about division by zero");
+}
+
+/*
+;;; Local Variables: ***
+;;; mode: C++ ***
+;;; End: ***
+*/