Mercurial > hg > octave-nkf
changeset 2376:2142216bf85a
[project @ 1996-10-12 01:39:07 by jwe]
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/src/op-cm-cm.cc @@ -0,0 +1,243 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "op-cm-cm.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by complex matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (v1.complex_matrix_value () + + v2.complex_matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (v1.complex_matrix_value () + - v2.complex_matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (v1.complex_matrix_value () + * v2.complex_matrix_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return xdiv (v1.complex_matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +pow (const octave_value&, const octave_value&) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return xleftdiv (v1.complex_matrix_value (), v2.complex_matrix_value ()); +} + +#define BOOL_OP(OP, EMPTY_RESULT) \ + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + real (m1 (i, j)) OP real (m2 (i, j)), #OP, EMPTY_RESULT) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + BOOL_OP (<, 0.0); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + BOOL_OP (<=, 0.0); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) == m2 (i, j), "==", 1.0); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + BOOL_OP (>=, 0.0); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + BOOL_OP (>, 0.0); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) != m2 (i, j), "!=", 0.0); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (product (v1.complex_matrix_value (), + v2.complex_matrix_value ())); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (quotient (v1.complex_matrix_value (), + v2.complex_matrix_value ())); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return elem_xpow (v1.complex_matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + return octave_value (quotient (v2.complex_matrix_value (), + v1.complex_matrix_value ())); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) != 0.0 && m2 (i, j) != 0.0, "&", 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) != 0.0 || m2 (i, j) != 0.0, "|", 0.0); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, const octave_complex_matrix&); + + v1.assign (idx, v2.complex_matrix_value ()); + return octave_value (); +} + +void +install_cm_cm_ops (void) +{ + INSTALL_BINOP (add, octave_complex_matrix, octave_complex_matrix, add); + INSTALL_BINOP (sub, octave_complex_matrix, octave_complex_matrix, sub); + INSTALL_BINOP (mul, octave_complex_matrix, octave_complex_matrix, mul); + INSTALL_BINOP (div, octave_complex_matrix, octave_complex_matrix, div); + INSTALL_BINOP (pow, octave_complex_matrix, octave_complex_matrix, pow); + INSTALL_BINOP (ldiv, octave_complex_matrix, octave_complex_matrix, ldiv); + INSTALL_BINOP (lt, octave_complex_matrix, octave_complex_matrix, lt); + INSTALL_BINOP (le, octave_complex_matrix, octave_complex_matrix, le); + INSTALL_BINOP (eq, octave_complex_matrix, octave_complex_matrix, eq); + INSTALL_BINOP (ge, octave_complex_matrix, octave_complex_matrix, ge); + INSTALL_BINOP (gt, octave_complex_matrix, octave_complex_matrix, gt); + INSTALL_BINOP (ne, octave_complex_matrix, octave_complex_matrix, ne); + INSTALL_BINOP (el_mul, octave_complex_matrix, octave_complex_matrix, el_mul); + INSTALL_BINOP (el_div, octave_complex_matrix, octave_complex_matrix, el_div); + INSTALL_BINOP (el_pow, octave_complex_matrix, octave_complex_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex_matrix, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_complex_matrix, octave_complex_matrix, el_and); + INSTALL_BINOP (el_or, octave_complex_matrix, octave_complex_matrix, el_or); + + INSTALL_ASSIGNOP (octave_complex_matrix, octave_complex_matrix, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-cm.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cm_cm_h) +#define octave_op_cm_cm_h 1 + +extern void install_cm_cm_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-cs.cc @@ -0,0 +1,248 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "op-cm-cs.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by complex scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return octave_value (v1.complex_matrix_value () + v2.complex_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return octave_value (v1.complex_matrix_value () - v2.complex_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return octave_value (v1.complex_matrix_value () * v2.complex_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_matrix_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return xpow (v1.complex_matrix_value (), v2.complex_value ()); +} + +static octave_value +ldiv (const octave_value& v1, const octave_value&) +{ + gripe_nonconformant ("operator \\", v1.rows (), v1.columns (), 1, 1); + return octave_value (); +} + +#define BOOL_OP(OP) \ + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + Complex, s, v2.complex_value (), \ + real (m (i, j)) OP real (s)) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) == s); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) != s); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return octave_value (v1.complex_matrix_value () * v2.complex_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_matrix_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return elem_xpow (v1.complex_matrix_value (), v2.complex_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + return x_el_div (v2.complex_value (), v1.complex_matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) != 0.0 && s != 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) != 0.0 || s != 0.0); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, const octave_complex&); + + v1.assign (idx, v2.complex_matrix_value ()); + return octave_value (); +} + +void +install_cm_cs_ops (void) +{ + INSTALL_BINOP (add, octave_complex_matrix, octave_complex, add); + INSTALL_BINOP (sub, octave_complex_matrix, octave_complex, sub); + INSTALL_BINOP (mul, octave_complex_matrix, octave_complex, mul); + INSTALL_BINOP (div, octave_complex_matrix, octave_complex, div); + INSTALL_BINOP (pow, octave_complex_matrix, octave_complex, pow); + INSTALL_BINOP (ldiv, octave_complex_matrix, octave_complex, ldiv); + INSTALL_BINOP (lt, octave_complex_matrix, octave_complex, lt); + INSTALL_BINOP (le, octave_complex_matrix, octave_complex, le); + INSTALL_BINOP (eq, octave_complex_matrix, octave_complex, eq); + INSTALL_BINOP (ge, octave_complex_matrix, octave_complex, ge); + INSTALL_BINOP (gt, octave_complex_matrix, octave_complex, gt); + INSTALL_BINOP (ne, octave_complex_matrix, octave_complex, ne); + INSTALL_BINOP (el_mul, octave_complex_matrix, octave_complex, el_mul); + INSTALL_BINOP (el_div, octave_complex_matrix, octave_complex, el_div); + INSTALL_BINOP (el_pow, octave_complex_matrix, octave_complex, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex_matrix, octave_complex, el_ldiv); + INSTALL_BINOP (el_and, octave_complex_matrix, octave_complex, el_and); + INSTALL_BINOP (el_or, octave_complex_matrix, octave_complex, el_or); + + INSTALL_ASSIGNOP (octave_complex_matrix, octave_complex, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-cs.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cm_cs_h) +#define octave_op_cm_cs_h 1 + +extern void install_cm_cs_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-m.cc @@ -0,0 +1,238 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "op-cm-m.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return octave_value (v1.complex_matrix_value () + v2.matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return octave_value (v1.complex_matrix_value () - v2.matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return octave_value (v1.complex_matrix_value () * v2.matrix_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return xdiv (v1.complex_matrix_value (), v2.matrix_value ()); +} + +static octave_value +pow (const octave_value&, const octave_value&) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return xleftdiv (v1.complex_matrix_value (), v2.matrix_value ()); +} + +#define BOOL_OP(OP, EMPTY_RESULT) \ + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + real (m1 (i, j)) OP m2 (i, j), #OP, EMPTY_RESULT) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + BOOL_OP (<, 0.0); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + BOOL_OP (<=, 0.0); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) == m2 (i, j), "==", 1.0); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + BOOL_OP (>=, 0.0); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + BOOL_OP (>, 0.0); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) != m2 (i, j), "!=", 0.0); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return product (v1.complex_matrix_value (), v2.matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return quotient (v1.complex_matrix_value (), v2.matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return elem_xpow (v1.complex_matrix_value (), v2.matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + return quotient (v2.matrix_value (), v1.complex_matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) != 0.0 && m2 (i, j), "&", 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (ComplexMatrix, m1, v1.complex_matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) != 0.0 || m2 (i, j), "|", 0.0); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, const octave_matrix&); + + v1.assign (idx, v2.complex_matrix_value ()); + return octave_value (); +} + +void +install_cm_m_ops (void) +{ + INSTALL_BINOP (add, octave_complex_matrix, octave_matrix, add); + INSTALL_BINOP (sub, octave_complex_matrix, octave_matrix, sub); + INSTALL_BINOP (mul, octave_complex_matrix, octave_matrix, mul); + INSTALL_BINOP (div, octave_complex_matrix, octave_matrix, div); + INSTALL_BINOP (pow, octave_complex_matrix, octave_matrix, pow); + INSTALL_BINOP (ldiv, octave_complex_matrix, octave_matrix, ldiv); + INSTALL_BINOP (lt, octave_complex_matrix, octave_matrix, lt); + INSTALL_BINOP (le, octave_complex_matrix, octave_matrix, le); + INSTALL_BINOP (eq, octave_complex_matrix, octave_matrix, eq); + INSTALL_BINOP (ge, octave_complex_matrix, octave_matrix, ge); + INSTALL_BINOP (gt, octave_complex_matrix, octave_matrix, gt); + INSTALL_BINOP (ne, octave_complex_matrix, octave_matrix, ne); + INSTALL_BINOP (el_mul, octave_complex_matrix, octave_matrix, el_mul); + INSTALL_BINOP (el_div, octave_complex_matrix, octave_matrix, el_div); + INSTALL_BINOP (el_pow, octave_complex_matrix, octave_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex_matrix, octave_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_complex_matrix, octave_matrix, el_and); + INSTALL_BINOP (el_or, octave_complex_matrix, octave_matrix, el_or); + + INSTALL_ASSIGNOP (octave_complex_matrix, octave_matrix, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-m.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cm_m_h) +#define octave_op_cm_m_h 1 + +extern void install_cm_m_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-s.cc @@ -0,0 +1,248 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-cx-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "op-cm-s.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex matrix by scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return octave_value (v1.complex_matrix_value () + v2.double_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return octave_value (v1.complex_matrix_value () - v2.double_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return octave_value (v1.complex_matrix_value () * v2.double_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_matrix_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return xpow (v1.complex_matrix_value (), v2.double_value ()); +} + +static octave_value +ldiv (const octave_value& v1, const octave_value&) +{ + gripe_nonconformant ("operator \\", v1.rows (), v1.columns (), 1, 1); + return octave_value (); +} + +#define BOOL_OP(OP) \ + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + double, s, v2.double_value (), \ + real (m (i, j)) OP s) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) == s); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) != s); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return octave_value (v1.complex_matrix_value () * v2.double_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_matrix_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return elem_xpow (v1.complex_matrix_value (), v2.double_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + return x_el_div (v2.double_value (), v1.complex_matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) != 0.0 && s); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (ComplexMatrix, m, v1.complex_matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) != 0.0 || s); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_complex_matrix&, const octave_scalar&); + + v1.assign (idx, v2.complex_matrix_value ()); + return octave_value (); +} + +void +install_cm_s_ops (void) +{ + INSTALL_BINOP (add, octave_complex_matrix, octave_scalar, add); + INSTALL_BINOP (sub, octave_complex_matrix, octave_scalar, sub); + INSTALL_BINOP (mul, octave_complex_matrix, octave_scalar, mul); + INSTALL_BINOP (div, octave_complex_matrix, octave_scalar, div); + INSTALL_BINOP (pow, octave_complex_matrix, octave_scalar, pow); + INSTALL_BINOP (ldiv, octave_complex_matrix, octave_scalar, ldiv); + INSTALL_BINOP (lt, octave_complex_matrix, octave_scalar, lt); + INSTALL_BINOP (le, octave_complex_matrix, octave_scalar, le); + INSTALL_BINOP (eq, octave_complex_matrix, octave_scalar, eq); + INSTALL_BINOP (ge, octave_complex_matrix, octave_scalar, ge); + INSTALL_BINOP (gt, octave_complex_matrix, octave_scalar, gt); + INSTALL_BINOP (ne, octave_complex_matrix, octave_scalar, ne); + INSTALL_BINOP (el_mul, octave_complex_matrix, octave_scalar, el_mul); + INSTALL_BINOP (el_div, octave_complex_matrix, octave_scalar, el_div); + INSTALL_BINOP (el_pow, octave_complex_matrix, octave_scalar, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex_matrix, octave_scalar, el_ldiv); + INSTALL_BINOP (el_and, octave_complex_matrix, octave_scalar, el_and); + INSTALL_BINOP (el_or, octave_complex_matrix, octave_scalar, el_or); + + INSTALL_ASSIGNOP (octave_complex_matrix, octave_scalar, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cm-s.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cm_s_h) +#define octave_op_cm_s_h 1 + +extern void install_cm_s_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-cm.cc @@ -0,0 +1,236 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "op-cs-cm.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by complex matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return octave_value (v1.complex_value () + v2.complex_matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return octave_value (v1.complex_value () - v2.complex_matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return octave_value (v1.complex_value () * v2.complex_matrix_value ()); +} + +static octave_value +div (const octave_value&, const octave_value& v2) +{ + gripe_nonconformant ("operator /", 1, 1, v2.rows (), v2.columns ()); + return octave_value (); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return xpow (v1.complex_value (), v2.complex_matrix_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_matrix_value () / d); +} + +#define BOOL_OP(OP) \ + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + real (s) OP real (m (i, j))) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s == m (i, j)); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s != m (i, j)); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return octave_value (v1.complex_value () * v2.complex_matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return x_el_div (v1.complex_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + return elem_xpow (v1.complex_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_matrix_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s != 0.0 && m (i, j) != 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s != 0.0 || m (i, j) != 0.0); +} + +void +install_cs_cm_ops (void) +{ + INSTALL_BINOP (add, octave_complex, octave_complex_matrix, add); + INSTALL_BINOP (sub, octave_complex, octave_complex_matrix, sub); + INSTALL_BINOP (mul, octave_complex, octave_complex_matrix, mul); + INSTALL_BINOP (div, octave_complex, octave_complex_matrix, div); + INSTALL_BINOP (pow, octave_complex, octave_complex_matrix, pow); + INSTALL_BINOP (ldiv, octave_complex, octave_complex_matrix, ldiv); + INSTALL_BINOP (lt, octave_complex, octave_complex_matrix, lt); + INSTALL_BINOP (le, octave_complex, octave_complex_matrix, le); + INSTALL_BINOP (eq, octave_complex, octave_complex_matrix, eq); + INSTALL_BINOP (ge, octave_complex, octave_complex_matrix, ge); + INSTALL_BINOP (gt, octave_complex, octave_complex_matrix, gt); + INSTALL_BINOP (ne, octave_complex, octave_complex_matrix, ne); + INSTALL_BINOP (el_mul, octave_complex, octave_complex_matrix, el_mul); + INSTALL_BINOP (el_div, octave_complex, octave_complex_matrix, el_div); + INSTALL_BINOP (el_pow, octave_complex, octave_complex_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_complex, octave_complex_matrix, el_and); + INSTALL_BINOP (el_or, octave_complex, octave_complex_matrix, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-cm.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cs_cm_h) +#define octave_op_cs_cm_h 1 + +extern void install_cs_cm_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-cs.cc @@ -0,0 +1,233 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "op-cs-cs.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by complex scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return octave_value (v1.complex_value () + v2.complex_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return octave_value (v1.complex_value () - v2.complex_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return octave_value (v1.complex_value () * v2.complex_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return xpow (v1.complex_value (), v2.complex_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return real (v1.complex_value ()) < real (v2.complex_value ()); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return real (v1.complex_value ()) <= real (v2.complex_value ()); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () == v2.complex_value (); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return real (v1.complex_value ()) >= real (v2.complex_value ()); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return real (v1.complex_value ()) > real (v2.complex_value ()); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () != v2.complex_value (); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return octave_value (v1.complex_value () * v2.complex_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return xpow (v1.complex_value (), v2.complex_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () != 0.0 && v2.complex_value () != 0.0; +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_complex&); + + return v1.complex_value () != 0.0 || v2.complex_value () != 0.0; +} + +void +install_cs_cs_ops (void) +{ + INSTALL_BINOP (add, octave_complex, octave_complex, add); + INSTALL_BINOP (sub, octave_complex, octave_complex, sub); + INSTALL_BINOP (mul, octave_complex, octave_complex, mul); + INSTALL_BINOP (div, octave_complex, octave_complex, div); + INSTALL_BINOP (pow, octave_complex, octave_complex, pow); + INSTALL_BINOP (ldiv, octave_complex, octave_complex, ldiv); + INSTALL_BINOP (lt, octave_complex, octave_complex, lt); + INSTALL_BINOP (le, octave_complex, octave_complex, le); + INSTALL_BINOP (eq, octave_complex, octave_complex, eq); + INSTALL_BINOP (ge, octave_complex, octave_complex, ge); + INSTALL_BINOP (gt, octave_complex, octave_complex, gt); + INSTALL_BINOP (ne, octave_complex, octave_complex, ne); + INSTALL_BINOP (el_mul, octave_complex, octave_complex, el_mul); + INSTALL_BINOP (el_div, octave_complex, octave_complex, el_div); + INSTALL_BINOP (el_pow, octave_complex, octave_complex, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex, octave_complex, el_ldiv); + INSTALL_BINOP (el_and, octave_complex, octave_complex, el_and); + INSTALL_BINOP (el_or, octave_complex, octave_complex, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-cs.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cs_cs_h) +#define octave_op_cs_cs_h 1 + +extern void install_cs_cs_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-m.cc @@ -0,0 +1,236 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "op-cs-m.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return octave_value (v1.complex_value () + v2.matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return octave_value (v1.complex_value () - v2.matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return octave_value (v1.complex_value () * v2.matrix_value ()); +} + +static octave_value +div (const octave_value&, const octave_value& v2) +{ + gripe_nonconformant ("operator /", 1, 1, v2.rows (), v2.columns ()); + return octave_value (); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return xpow (v1.complex_value (), v2.matrix_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.matrix_value () / d); +} + +#define BOOL_OP(OP) \ + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + Matrix, m, v2.matrix_value (), \ + real (s) OP m (i, j)) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + Matrix, m, v2.matrix_value (), \ + s == m (i, j)); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + Matrix, m, v2.matrix_value (), \ + s != m (i, j)); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return octave_value (v1.complex_value () * v2.matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return x_el_div (v1.complex_value (), v2.matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + return elem_xpow (v1.complex_value (), v2.matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + Complex d = v1.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.matrix_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + Matrix, m, v2.matrix_value (), \ + s != 0.0 && m (i, j)); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_matrix&); + + SC_MX_BOOL_OP (Complex, s, v1.complex_value (), \ + Matrix, m, v2.matrix_value (), \ + s != 0.0 || m (i, j)); +} + +void +install_cs_m_ops (void) +{ + INSTALL_BINOP (add, octave_complex, octave_matrix, add); + INSTALL_BINOP (sub, octave_complex, octave_matrix, sub); + INSTALL_BINOP (mul, octave_complex, octave_matrix, mul); + INSTALL_BINOP (div, octave_complex, octave_matrix, div); + INSTALL_BINOP (pow, octave_complex, octave_matrix, pow); + INSTALL_BINOP (ldiv, octave_complex, octave_matrix, ldiv); + INSTALL_BINOP (lt, octave_complex, octave_matrix, lt); + INSTALL_BINOP (le, octave_complex, octave_matrix, le); + INSTALL_BINOP (eq, octave_complex, octave_matrix, eq); + INSTALL_BINOP (ge, octave_complex, octave_matrix, ge); + INSTALL_BINOP (gt, octave_complex, octave_matrix, gt); + INSTALL_BINOP (ne, octave_complex, octave_matrix, ne); + INSTALL_BINOP (el_mul, octave_complex, octave_matrix, el_mul); + INSTALL_BINOP (el_div, octave_complex, octave_matrix, el_div); + INSTALL_BINOP (el_pow, octave_complex, octave_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex, octave_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_complex, octave_matrix, el_and); + INSTALL_BINOP (el_or, octave_complex, octave_matrix, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-m.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cs_m_h) +#define octave_op_cs_m_h 1 + +extern void install_cs_m_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-s.cc @@ -0,0 +1,234 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-complex.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "op-cs-s.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// complex scalar by scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return octave_value (v1.complex_value () + v2.double_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return octave_value (v1.complex_value () - v2.double_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return octave_value (v1.complex_value () * v2.double_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return xpow (v1.complex_value (), v2.double_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return real (v1.complex_value ()) < v2.double_value (); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return real (v1.complex_value ()) <= v2.double_value (); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () == v2.double_value (); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return real (v1.complex_value ()) >= v2.double_value (); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return real (v1.complex_value ()) > v2.double_value (); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () != v2.double_value (); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return octave_value (v1.complex_value () * v2.double_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.complex_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return xpow (v1.complex_value (), v2.double_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () != 0.0 && v2.double_value (); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_complex&, const octave_scalar&); + + return v1.complex_value () != 0.0 || v2.double_value (); +} + +void +install_cs_s_ops (void) +{ + INSTALL_BINOP (add, octave_complex, octave_scalar, add); + INSTALL_BINOP (sub, octave_complex, octave_scalar, sub); + INSTALL_BINOP (mul, octave_complex, octave_scalar, mul); + INSTALL_BINOP (div, octave_complex, octave_scalar, div); + INSTALL_BINOP (pow, octave_complex, octave_scalar, pow); + INSTALL_BINOP (ldiv, octave_complex, octave_scalar, ldiv); + INSTALL_BINOP (lt, octave_complex, octave_scalar, lt); + INSTALL_BINOP (le, octave_complex, octave_scalar, le); + INSTALL_BINOP (eq, octave_complex, octave_scalar, eq); + INSTALL_BINOP (ge, octave_complex, octave_scalar, ge); + INSTALL_BINOP (gt, octave_complex, octave_scalar, gt); + INSTALL_BINOP (ne, octave_complex, octave_scalar, ne); + INSTALL_BINOP (el_mul, octave_complex, octave_scalar, el_mul); + INSTALL_BINOP (el_div, octave_complex, octave_scalar, el_div); + INSTALL_BINOP (el_pow, octave_complex, octave_scalar, el_pow); + INSTALL_BINOP (el_ldiv, octave_complex, octave_scalar, el_ldiv); + INSTALL_BINOP (el_and, octave_complex, octave_scalar, el_and); + INSTALL_BINOP (el_or, octave_complex, octave_scalar, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-cs-s.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_cs_s_h) +#define octave_op_cs_s_h 1 + +extern void install_cs_s_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-cm.cc @@ -0,0 +1,238 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "op-m-cm.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return octave_value (v1.matrix_value () + v2.complex_matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return octave_value (v1.matrix_value () - v2.complex_matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return octave_value (v1.matrix_value () * v2.complex_matrix_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return xdiv (v1.matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +pow (const octave_value&, const octave_value&) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return xleftdiv (v1.matrix_value (), v2.complex_matrix_value ()); +} + +#define BOOL_OP(OP, EMPTY_RESULT) \ + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) OP real (m2 (i, j)), #OP, EMPTY_RESULT) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + BOOL_OP (<, 0.0); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + BOOL_OP (<=, 0.0); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) == m2 (i, j), "==", 1.0); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + BOOL_OP (>=, 0.0); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + BOOL_OP (>, 0.0); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) != m2 (i, j), "!=", 0.0); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return product (v1.matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return quotient (v1.matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return elem_xpow (v1.matrix_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + return quotient (v2.complex_matrix_value (), v1.matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) && m2 (i, j) != 0.0, "&", 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + ComplexMatrix, m2, v2.complex_matrix_value (), \ + m1 (i, j) || m2 (i, j) != 0.0, "|", 0.0); +} + +static octave_value * +complex_matrix_conv (const octave_value& a) +{ + CAST_CONV_ARG (const octave_matrix&); + + return new octave_complex_matrix (ComplexMatrix (v.matrix_value ())); +} + +void +install_m_cm_ops (void) +{ + INSTALL_BINOP (add, octave_matrix, octave_complex_matrix, add); + INSTALL_BINOP (sub, octave_matrix, octave_complex_matrix, sub); + INSTALL_BINOP (mul, octave_matrix, octave_complex_matrix, mul); + INSTALL_BINOP (div, octave_matrix, octave_complex_matrix, div); + INSTALL_BINOP (pow, octave_matrix, octave_complex_matrix, pow); + INSTALL_BINOP (ldiv, octave_matrix, octave_complex_matrix, ldiv); + INSTALL_BINOP (lt, octave_matrix, octave_complex_matrix, lt); + INSTALL_BINOP (le, octave_matrix, octave_complex_matrix, le); + INSTALL_BINOP (eq, octave_matrix, octave_complex_matrix, eq); + INSTALL_BINOP (ge, octave_matrix, octave_complex_matrix, ge); + INSTALL_BINOP (gt, octave_matrix, octave_complex_matrix, gt); + INSTALL_BINOP (ne, octave_matrix, octave_complex_matrix, ne); + INSTALL_BINOP (el_mul, octave_matrix, octave_complex_matrix, el_mul); + INSTALL_BINOP (el_div, octave_matrix, octave_complex_matrix, el_div); + INSTALL_BINOP (el_pow, octave_matrix, octave_complex_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_matrix, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_matrix, octave_complex_matrix, el_and); + INSTALL_BINOP (el_or, octave_matrix, octave_complex_matrix, el_or); + + INSTALL_ASSIGNCONV (octave_matrix, octave_complex_matrix, octave_complex_matrix); + + INSTALL_WIDENOP (octave_matrix, octave_complex_matrix, complex_matrix_conv); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-cm.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_m_cm_h) +#define octave_op_m_cm_h 1 + +extern void install_m_cm_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-cs.cc @@ -0,0 +1,249 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-cx-mat.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "op-m-cs.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by complex scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return octave_value (v1.matrix_value () + v2.complex_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return octave_value (v1.matrix_value () - v2.complex_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return octave_value (v1.matrix_value () * v2.complex_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.matrix_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return xpow (v1.matrix_value (), v2.complex_value ()); +} + +static octave_value +ldiv (const octave_value& v1, const octave_value&) +{ + gripe_nonconformant ("operator \\", v1.rows (), v1.columns (), 1, 1); + return octave_value (); +} + +#define BOOL_OP(OP) \ + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) OP real (s)) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) == s); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) != s); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return octave_value (v1.matrix_value () * v2.complex_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.matrix_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return elem_xpow (v1.matrix_value (), v2.complex_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + return x_el_div (v2.complex_value (), v1.matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) && s != 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_complex&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + Complex, s, v2.complex_value (), \ + m (i, j) || s != 0.0); +} + +static octave_value * +complex_matrix_conv (const octave_value& a) +{ + CAST_CONV_ARG (const octave_matrix&); + + return new octave_complex_matrix (ComplexMatrix (v.matrix_value ())); +} + +void +install_m_cs_ops (void) +{ + INSTALL_BINOP (add, octave_matrix, octave_complex, add); + INSTALL_BINOP (sub, octave_matrix, octave_complex, sub); + INSTALL_BINOP (mul, octave_matrix, octave_complex, mul); + INSTALL_BINOP (div, octave_matrix, octave_complex, div); + INSTALL_BINOP (pow, octave_matrix, octave_complex, pow); + INSTALL_BINOP (ldiv, octave_matrix, octave_complex, ldiv); + INSTALL_BINOP (lt, octave_matrix, octave_complex, lt); + INSTALL_BINOP (le, octave_matrix, octave_complex, le); + INSTALL_BINOP (eq, octave_matrix, octave_complex, eq); + INSTALL_BINOP (ge, octave_matrix, octave_complex, ge); + INSTALL_BINOP (gt, octave_matrix, octave_complex, gt); + INSTALL_BINOP (ne, octave_matrix, octave_complex, ne); + INSTALL_BINOP (el_mul, octave_matrix, octave_complex, el_mul); + INSTALL_BINOP (el_div, octave_matrix, octave_complex, el_div); + INSTALL_BINOP (el_pow, octave_matrix, octave_complex, el_pow); + INSTALL_BINOP (el_ldiv, octave_matrix, octave_complex, el_ldiv); + INSTALL_BINOP (el_and, octave_matrix, octave_complex, el_and); + INSTALL_BINOP (el_or, octave_matrix, octave_complex, el_or); + + INSTALL_ASSIGNCONV (octave_matrix, octave_complex, octave_complex_matrix); + + INSTALL_WIDENOP (octave_matrix, octave_complex_matrix, complex_matrix_conv); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-cs.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_m_cs_h) +#define octave_op_m_cs_h 1 + +extern void install_m_cs_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-m.cc @@ -0,0 +1,233 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "op-m-m.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (v1.matrix_value () + v2.matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (v1.matrix_value () - v2.matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (v1.matrix_value () * v2.matrix_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return xdiv (v1.matrix_value (), v2.matrix_value ()); +} + +static octave_value +pow (const octave_value&, const octave_value&) +{ + error ("can't do A ^ B for A and B both matrices"); + return octave_value (); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return xleftdiv (v1.matrix_value (), v2.matrix_value ()); +} + +#define BOOL_OP(OP, EMPTY_RESULT) \ + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) OP m2 (i, j), #OP, EMPTY_RESULT) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (<, 0.0); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (<=, 0.0); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (==, 1.0); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (>=, 0.0); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (>, 0.0); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + BOOL_OP (!=, 0.0); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (product (v1.matrix_value (), v2.matrix_value ())); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (quotient (v1.matrix_value (), v2.matrix_value ())); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return elem_xpow (v1.matrix_value (), v2.matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + return octave_value (quotient (v2.matrix_value (), v1.matrix_value ())); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) && m2 (i, j), "&", 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_matrix&); + + MX_MX_BOOL_OP (Matrix, m1, v1.matrix_value (), \ + Matrix, m2, v2.matrix_value (), \ + m1 (i, j) || m2 (i, j), "|", 0.0); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_matrix&); + + v1.assign (idx, v2.matrix_value ()); + return octave_value (); +} + +void +install_m_m_ops (void) +{ + INSTALL_BINOP (add, octave_matrix, octave_matrix, add); + INSTALL_BINOP (sub, octave_matrix, octave_matrix, sub); + INSTALL_BINOP (mul, octave_matrix, octave_matrix, mul); + INSTALL_BINOP (div, octave_matrix, octave_matrix, div); + INSTALL_BINOP (pow, octave_matrix, octave_matrix, pow); + INSTALL_BINOP (ldiv, octave_matrix, octave_matrix, ldiv); + INSTALL_BINOP (lt, octave_matrix, octave_matrix, lt); + INSTALL_BINOP (le, octave_matrix, octave_matrix, le); + INSTALL_BINOP (eq, octave_matrix, octave_matrix, eq); + INSTALL_BINOP (ge, octave_matrix, octave_matrix, ge); + INSTALL_BINOP (gt, octave_matrix, octave_matrix, gt); + INSTALL_BINOP (ne, octave_matrix, octave_matrix, ne); + INSTALL_BINOP (el_mul, octave_matrix, octave_matrix, el_mul); + INSTALL_BINOP (el_div, octave_matrix, octave_matrix, el_div); + INSTALL_BINOP (el_pow, octave_matrix, octave_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_matrix, octave_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_matrix, octave_matrix, el_and); + INSTALL_BINOP (el_or, octave_matrix, octave_matrix, el_or); + + INSTALL_ASSIGNOP (octave_matrix, octave_matrix, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-m.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_m_m_h) +#define octave_op_m_m_h 1 + +extern void install_m_m_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-s.cc @@ -0,0 +1,244 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-re-mat.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "op-m-s.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// matrix by scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return octave_value (v1.matrix_value () + v2.double_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return octave_value (v1.matrix_value () - v2.double_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return octave_value (v1.matrix_value () * v2.double_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.matrix_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return xpow (v1.matrix_value (), v2.double_value ()); +} + +static octave_value +ldiv (const octave_value& v1, const octave_value&) +{ + gripe_nonconformant ("operator \\", v1.rows (), v1.columns (), 1, 1); + return octave_value (); +} + +#define BOOL_OP(OP) \ + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) OP s) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (==); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + BOOL_OP (!=); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return octave_value (v1.matrix_value () * v2.double_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.matrix_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return elem_xpow (v1.matrix_value (), v2.double_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + return x_el_div (v2.double_value (), v1.matrix_value ()); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) && s); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_matrix&, const octave_scalar&); + + MX_SC_BOOL_OP (Matrix, m, v1.matrix_value (), \ + double, s, v2.double_value (), \ + m (i, j) || s); +} + +static octave_value +assign (octave_value& a1, const octave_value_list& idx, + const octave_value& a2) +{ + CAST_BINOP_ARGS (octave_matrix&, const octave_scalar&); + + v1.assign (idx, v2.matrix_value ()); + return octave_value (); +} + +void +install_m_s_ops (void) +{ + INSTALL_BINOP (add, octave_matrix, octave_scalar, add); + INSTALL_BINOP (sub, octave_matrix, octave_scalar, sub); + INSTALL_BINOP (mul, octave_matrix, octave_scalar, mul); + INSTALL_BINOP (div, octave_matrix, octave_scalar, div); + INSTALL_BINOP (pow, octave_matrix, octave_scalar, pow); + INSTALL_BINOP (ldiv, octave_matrix, octave_scalar, ldiv); + INSTALL_BINOP (lt, octave_matrix, octave_scalar, lt); + INSTALL_BINOP (le, octave_matrix, octave_scalar, le); + INSTALL_BINOP (eq, octave_matrix, octave_scalar, eq); + INSTALL_BINOP (ge, octave_matrix, octave_scalar, ge); + INSTALL_BINOP (gt, octave_matrix, octave_scalar, gt); + INSTALL_BINOP (ne, octave_matrix, octave_scalar, ne); + INSTALL_BINOP (el_mul, octave_matrix, octave_scalar, el_mul); + INSTALL_BINOP (el_div, octave_matrix, octave_scalar, el_div); + INSTALL_BINOP (el_pow, octave_matrix, octave_scalar, el_pow); + INSTALL_BINOP (el_ldiv, octave_matrix, octave_scalar, el_ldiv); + INSTALL_BINOP (el_and, octave_matrix, octave_scalar, el_and); + INSTALL_BINOP (el_or, octave_matrix, octave_scalar, el_or); + + INSTALL_ASSIGNOP (octave_matrix, octave_scalar, assign); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-m-s.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_m_s_h) +#define octave_op_m_s_h 1 + +extern void install_m_s_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-cm.cc @@ -0,0 +1,236 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-cx-mat.h" +#include "ov-typeinfo.h" +#include "op-s-cm.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return octave_value (v1.double_value () + v2.complex_matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return octave_value (v1.double_value () - v2.complex_matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return octave_value (v1.double_value () * v2.complex_matrix_value ()); +} + +static octave_value +div (const octave_value&, const octave_value& v2) +{ + gripe_nonconformant ("operator /", 1, 1, v2.rows (), v2.columns ()); + return octave_value (); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return xpow (v1.double_value (), v2.complex_matrix_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_matrix_value () / d); +} + +#define BOOL_OP(OP) \ + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s OP real (m (i, j))) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s == m (i, j)); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s != m (i, j)); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return octave_value (v1.double_value () * v2.complex_matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return x_el_div (v1.double_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + return elem_xpow (v1.double_value (), v2.complex_matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_matrix_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s && m (i, j) != 0.0); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + ComplexMatrix, m, v2.complex_matrix_value (), \ + s || m (i, j) != 0.0); +} + +void +install_s_cm_ops (void) +{ + INSTALL_BINOP (add, octave_scalar, octave_complex_matrix, add); + INSTALL_BINOP (sub, octave_scalar, octave_complex_matrix, sub); + INSTALL_BINOP (mul, octave_scalar, octave_complex_matrix, mul); + INSTALL_BINOP (div, octave_scalar, octave_complex_matrix, div); + INSTALL_BINOP (pow, octave_scalar, octave_complex_matrix, pow); + INSTALL_BINOP (ldiv, octave_scalar, octave_complex_matrix, ldiv); + INSTALL_BINOP (lt, octave_scalar, octave_complex_matrix, lt); + INSTALL_BINOP (le, octave_scalar, octave_complex_matrix, le); + INSTALL_BINOP (eq, octave_scalar, octave_complex_matrix, eq); + INSTALL_BINOP (ge, octave_scalar, octave_complex_matrix, ge); + INSTALL_BINOP (gt, octave_scalar, octave_complex_matrix, gt); + INSTALL_BINOP (ne, octave_scalar, octave_complex_matrix, ne); + INSTALL_BINOP (el_mul, octave_scalar, octave_complex_matrix, el_mul); + INSTALL_BINOP (el_div, octave_scalar, octave_complex_matrix, el_div); + INSTALL_BINOP (el_pow, octave_scalar, octave_complex_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_scalar, octave_complex_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_scalar, octave_complex_matrix, el_and); + INSTALL_BINOP (el_or, octave_scalar, octave_complex_matrix, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-cm.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_s_cm_h) +#define octave_op_s_cm_h 1 + +extern void install_s_cm_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-cs.cc @@ -0,0 +1,234 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-complex.h" +#include "ov-typeinfo.h" +#include "op-s-cs.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by complex scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () + v2.complex_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () - v2.complex_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () * v2.complex_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return xpow (v1.double_value (), v2.complex_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () < v2.double_value ()); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () <= v2.double_value ()); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () == v2.complex_value ()); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () >= v2.double_value ()); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () > v2.double_value ()); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () != v2.complex_value ()); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () * v2.complex_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + Complex d = v2.complex_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return xpow (v1.double_value (), v2.complex_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.complex_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () && (v2.complex_value () != 0.0)); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_complex&); + + return octave_value (v1.double_value () || (v2.complex_value () != 0.0)); +} + +void +install_s_cs_ops (void) +{ + INSTALL_BINOP (add, octave_scalar, octave_complex, add); + INSTALL_BINOP (sub, octave_scalar, octave_complex, sub); + INSTALL_BINOP (mul, octave_scalar, octave_complex, mul); + INSTALL_BINOP (div, octave_scalar, octave_complex, div); + INSTALL_BINOP (pow, octave_scalar, octave_complex, pow); + INSTALL_BINOP (ldiv, octave_scalar, octave_complex, ldiv); + INSTALL_BINOP (lt, octave_scalar, octave_complex, lt); + INSTALL_BINOP (le, octave_scalar, octave_complex, le); + INSTALL_BINOP (eq, octave_scalar, octave_complex, eq); + INSTALL_BINOP (ge, octave_scalar, octave_complex, ge); + INSTALL_BINOP (gt, octave_scalar, octave_complex, gt); + INSTALL_BINOP (ne, octave_scalar, octave_complex, ne); + INSTALL_BINOP (el_mul, octave_scalar, octave_complex, el_mul); + INSTALL_BINOP (el_div, octave_scalar, octave_complex, el_div); + INSTALL_BINOP (el_pow, octave_scalar, octave_complex, el_pow); + INSTALL_BINOP (el_ldiv, octave_scalar, octave_complex, el_ldiv); + INSTALL_BINOP (el_and, octave_scalar, octave_complex, el_and); + INSTALL_BINOP (el_or, octave_scalar, octave_complex, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-cs.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_s_cs_h) +#define octave_op_s_cs_h 1 + +extern void install_s_cs_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-m.cc @@ -0,0 +1,232 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-re-mat.h" +#include "ov-typeinfo.h" +#include "op-s-m.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by matrix ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return octave_value (v1.double_value () + v2.matrix_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return octave_value (v1.double_value () - v2.matrix_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return octave_value (v1.double_value () * v2.matrix_value ()); +} + +static octave_value +div (const octave_value&, const octave_value& v2) +{ + gripe_nonconformant ("operator /", 1, 1, v2.rows (), v2.columns ()); + return octave_value (); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return xpow (v1.double_value (), v2.matrix_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.matrix_value () / d); +} + +#define BOOL_OP(OP) \ + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + Matrix, m, v2.matrix_value (), \ + s OP m (i, j)) + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (<); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (<=); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (==); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (>=); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (>); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + BOOL_OP (!=); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return octave_value (v1.double_value () * v2.matrix_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return x_el_div (v1.double_value (), v2.matrix_value ()); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + return elem_xpow (v1.double_value (), v2.matrix_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.matrix_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + Matrix, m, v2.matrix_value (), \ + s && m (i, j)); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_matrix&); + + SC_MX_BOOL_OP (double, s, v1.double_value (), \ + Matrix, m, v2.matrix_value (), \ + s || m (i, j)); +} + +void +install_s_m_ops (void) +{ + INSTALL_BINOP (add, octave_scalar, octave_matrix, add); + INSTALL_BINOP (sub, octave_scalar, octave_matrix, sub); + INSTALL_BINOP (mul, octave_scalar, octave_matrix, mul); + INSTALL_BINOP (div, octave_scalar, octave_matrix, div); + INSTALL_BINOP (pow, octave_scalar, octave_matrix, pow); + INSTALL_BINOP (ldiv, octave_scalar, octave_matrix, ldiv); + INSTALL_BINOP (lt, octave_scalar, octave_matrix, lt); + INSTALL_BINOP (le, octave_scalar, octave_matrix, le); + INSTALL_BINOP (eq, octave_scalar, octave_matrix, eq); + INSTALL_BINOP (ge, octave_scalar, octave_matrix, ge); + INSTALL_BINOP (gt, octave_scalar, octave_matrix, gt); + INSTALL_BINOP (ne, octave_scalar, octave_matrix, ne); + INSTALL_BINOP (el_mul, octave_scalar, octave_matrix, el_mul); + INSTALL_BINOP (el_div, octave_scalar, octave_matrix, el_div); + INSTALL_BINOP (el_pow, octave_scalar, octave_matrix, el_pow); + INSTALL_BINOP (el_ldiv, octave_scalar, octave_matrix, el_ldiv); + INSTALL_BINOP (el_and, octave_scalar, octave_matrix, el_and); + INSTALL_BINOP (el_or, octave_scalar, octave_matrix, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-m.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_s_m_h) +#define octave_op_s_m_h 1 + +extern void install_s_m_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-s.cc @@ -0,0 +1,233 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "op-s-s.h" +#include "ops.h" +#include "xdiv.h" +#include "xpow.h" + +// scalar by scalar ops. + +static octave_value +add (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () + v2.double_value ()); +} + +static octave_value +sub (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () - v2.double_value ()); +} + +static octave_value +mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () * v2.double_value ()); +} + +static octave_value +div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +static octave_value +pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return xpow (v1.double_value (), v2.double_value ()); +} + +static octave_value +ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +static octave_value +lt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () < v2.double_value ()); +} + +static octave_value +le (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () <= v2.double_value ()); +} + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () == v2.double_value ()); +} + +static octave_value +ge (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () >= v2.double_value ()); +} + +static octave_value +gt (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () > v2.double_value ()); +} + +static octave_value +ne (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () != v2.double_value ()); +} + +static octave_value +el_mul (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () * v2.double_value ()); +} + +static octave_value +el_div (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v2.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v1.double_value () / d); +} + +static octave_value +el_pow (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return xpow (v1.double_value (), v2.double_value ()); +} + +static octave_value +el_ldiv (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + double d = v1.double_value (); + + if (d == 0.0) + gripe_divide_by_zero (); + + return octave_value (v2.double_value () / d); +} + +static octave_value +el_and (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () && v2.double_value ()); +} + +static octave_value +el_or (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_scalar&, const octave_scalar&); + + return octave_value (v1.double_value () || v2.double_value ()); +} + +void +install_s_s_ops (void) +{ + INSTALL_BINOP (add, octave_scalar, octave_scalar, add); + INSTALL_BINOP (sub, octave_scalar, octave_scalar, sub); + INSTALL_BINOP (mul, octave_scalar, octave_scalar, mul); + INSTALL_BINOP (div, octave_scalar, octave_scalar, div); + INSTALL_BINOP (pow, octave_scalar, octave_scalar, pow); + INSTALL_BINOP (ldiv, octave_scalar, octave_scalar, ldiv); + INSTALL_BINOP (lt, octave_scalar, octave_scalar, lt); + INSTALL_BINOP (le, octave_scalar, octave_scalar, le); + INSTALL_BINOP (eq, octave_scalar, octave_scalar, eq); + INSTALL_BINOP (ge, octave_scalar, octave_scalar, ge); + INSTALL_BINOP (gt, octave_scalar, octave_scalar, gt); + INSTALL_BINOP (ne, octave_scalar, octave_scalar, ne); + INSTALL_BINOP (el_mul, octave_scalar, octave_scalar, el_mul); + INSTALL_BINOP (el_div, octave_scalar, octave_scalar, el_div); + INSTALL_BINOP (el_pow, octave_scalar, octave_scalar, el_pow); + INSTALL_BINOP (el_ldiv, octave_scalar, octave_scalar, el_ldiv); + INSTALL_BINOP (el_and, octave_scalar, octave_scalar, el_and); + INSTALL_BINOP (el_or, octave_scalar, octave_scalar, el_or); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-s-s.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_s_s_h) +#define octave_op_s_s_h 1 + +extern void install_s_s_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-str-str.cc @@ -0,0 +1,58 @@ +/* + +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 "gripes.h" +#include "ov.h" +#include "ov-str-mat.h" +#include "ov-typeinfo.h" +#include "ops.h" + +// string by string ops. + +static octave_value +eq (const octave_value& a1, const octave_value& a2) +{ + CAST_BINOP_ARGS (const octave_char_matrix_str&, + const octave_char_matrix_str&); + + return octave_value (v1.char_matrix_value () == v2.char_matrix_value ()); +} + +void +install_str_str_ops (void) +{ + INSTALL_BINOP (eq, octave_char_matrix_str, octave_char_matrix_str, eq); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/op-str-str.h @@ -0,0 +1,34 @@ +/* + +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 (octave_op_str_str_h) +#define octave_op_str_str_h 1 + +extern void install_str_str_ops (void); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ops.cc @@ -0,0 +1,79 @@ +/* + +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 "ov-base.h" + +#include "op-cm-cm.h" +#include "op-cm-cs.h" +#include "op-cm-m.h" +#include "op-cm-s.h" +#include "op-cs-cm.h" +#include "op-cs-cs.h" +#include "op-cs-m.h" +#include "op-cs-s.h" +#include "op-m-cm.h" +#include "op-m-cs.h" +#include "op-m-m.h" +#include "op-m-s.h" +#include "op-s-cm.h" +#include "op-s-cs.h" +#include "op-s-m.h" +#include "op-s-s.h" +#include "op-str-str.h" + +void +install_ops (void) +{ + install_base_type_conversions (); + + install_cm_cm_ops (); + install_cm_cs_ops (); + install_cm_m_ops (); + install_cm_s_ops (); + install_cs_cm_ops (); + install_cs_cs_ops (); + install_cs_m_ops (); + install_cs_s_ops (); + install_m_cm_ops (); + install_m_cs_ops (); + install_m_m_ops (); + install_m_s_ops (); + install_s_cm_ops (); + install_s_cs_ops (); + install_s_m_ops (); + install_s_s_ops (); + install_str_str_ops (); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ops.h @@ -0,0 +1,115 @@ +/* + +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 (octave_ops_h) +#define octave_ops_h 1 + +extern void install_ops (void); + +#define INSTALL_UNOP(op, t, f) \ + octave_value_typeinfo::register_unary_op \ + (octave_value::op, t::static_type_id (), f); + +#define INSTALL_BINOP(op, t1, t2, f) \ + octave_value_typeinfo::register_binary_op \ + (octave_value::op, t1::static_type_id (), t2::static_type_id (), f); + +#define INSTALL_ASSIGNOP(t1, t2, f) \ + octave_value_typeinfo::register_assign_op \ + (t1::static_type_id (), t2::static_type_id (), f); + +#define INSTALL_ASSIGNCONV(t1, t2, tr) \ + octave_value_typeinfo::register_pref_assign_conv \ + (t1::static_type_id (), t2::static_type_id (), tr::static_type_id ()); + +#define INSTALL_WIDENOP(t1, t2, f) \ + octave_value_typeinfo::register_widening_op \ + (t1::static_type_id (), t2::static_type_id (), f); + +#define BOOL_OP1(xt, xn, get_x, yt, yn, get_y) \ + xt xn = get_x; \ + yt yn = get_y; + +#define BOOL_OP2(x) \ + int nr = x.rows (); \ + int nc = x.columns (); + +#define BOOL_OP3(test) \ + Matrix retval (nr, nc); \ + for (int j = 0; j < nc; j++) \ + for (int i = 0; i < nr; i++) \ + retval (i, j) = test; \ + return retval; + +#define SC_MX_BOOL_OP(st, sn, get_s, mt, mn, get_m, test) \ + do \ + { \ + BOOL_OP1 (st, sn, get_s, mt, mn, get_m) \ + BOOL_OP2 (mn) \ + BOOL_OP3 (test) \ + } \ + while (0) + +#define MX_SC_BOOL_OP(mt, mn, get_m, st, sn, get_s, test) \ + do \ + { \ + BOOL_OP1 (mt, mn, get_m, st, sn, get_s) \ + BOOL_OP2 (mn) \ + BOOL_OP3 (test) \ + } \ + while (0) + +#define MX_MX_BOOL_OP(m1t, m1n, get_m1, m2t, m2n, get_m2, test, op, \ + empty_result) \ + do \ + { \ + BOOL_OP1 (m1t, m1n, get_m1, m2t, m2n, get_m2) \ + int m1_nr = m1.rows (); \ + int m1_nc = m1.cols (); \ + int m2_nr = m2.rows (); \ + int m2_nc = m2.cols (); \ + if (m1_nr != m2_nr || m1_nc != m2_nc) \ + { \ + gripe_nonconformant ("operator " op, m1_nr, m1_nc, m2_nr, m2_nc); \ + return Matrix (); \ + } \ + if (m1_nr == 0 || m1_nc == 0) \ + return empty_result; \ + BOOL_OP2 (m1n) \ + BOOL_OP3 (test) \ + } \ + while (0) + +#define CAST_BINOP_ARGS(t1, t2) \ + t1 v1 = DYNAMIC_CAST (t1, a1); \ + t2 v2 = DYNAMIC_CAST (t2, a2); + +#define CAST_CONV_ARG(t) \ + t v = DYNAMIC_CAST (t, a); + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-base.cc @@ -0,0 +1,261 @@ +/* + +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 "lo-ieee.h" + +#include "gripes.h" +#include "oct-map.h" +#include "ops.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" + +int octave_base_value::t_id = -1; + +const string octave_base_value::t_name ("<unknown type>"); + +octave_value +octave_base_value::index (const octave_value_list&) const +{ + string nm = type_name (); + error ("can't perform indexing operations for %s type", nm.c_str ()); + return octave_value (); +} + +idx_vector +octave_base_value::index_vector (void) const +{ + string nm = type_name (); + error ("%s type invalid as index value", nm.c_str ()); + return idx_vector (); +} + +octave_value +octave_base_value::struct_elt_val (const string&) const +{ + string nm = type_name (); + error ("can't perform structure reference operations for %s type", + nm.c_str ()); + return octave_value (); +} + +octave_value& +octave_base_value::struct_elt_ref (const string&) +{ + static octave_value foo; + string nm = type_name (); + error ("can't perform structure reference operations for %s type", + nm.c_str ()); + return foo; +} + +octave_value +octave_base_value::convert_to_str (void) const +{ + gripe_wrong_type_arg ("octave_base_value::convert_to_str ()", + type_name ()); + return octave_value (); +} + +void +octave_base_value::convert_to_row_or_column_vector (void) +{ + gripe_wrong_type_arg + ("octave_base_value::convert_to_row_or_column_vector ()", + type_name ()); +} + +void +octave_base_value::print (ostream&) +{ + gripe_wrong_type_arg ("octave_base_value::print()", type_name ()); +} + +double +octave_base_value::double_value (bool) const +{ + double retval = octave_NaN; + gripe_wrong_type_arg ("octave_base_value::double_value ()", type_name ()); + return retval; +} + +Matrix +octave_base_value::matrix_value (bool) const +{ + Matrix retval; + gripe_wrong_type_arg ("octave_base_value::matrix_value()", type_name ()); + return retval; +} + +Complex +octave_base_value::complex_value (bool) const +{ + Complex retval (octave_NaN, octave_NaN); + gripe_wrong_type_arg ("octave_base_value::complex_value()", type_name ()); + return retval; +} + +ComplexMatrix +octave_base_value::complex_matrix_value (bool) const +{ + ComplexMatrix retval; + gripe_wrong_type_arg ("octave_base_value::complex_matrix_value()", + type_name ()); + return retval; +} + +charMatrix +octave_base_value::char_matrix_value (bool) const +{ + charMatrix retval; + gripe_wrong_type_arg ("octave_base_value::char_matrix_value()", + type_name ()); + return retval; +} + +charMatrix +octave_base_value::all_strings (void) const +{ + charMatrix retval; + gripe_wrong_type_arg ("octave_base_value::all_strings()", type_name ()); + return retval; +} + +string +octave_base_value::string_value (void) const +{ + string retval; + gripe_wrong_type_arg ("octave_base_value::string_value()", type_name ()); + return retval; +} + +Range +octave_base_value::range_value (void) const +{ + Range retval; + gripe_wrong_type_arg ("octave_base_value::range_value()", type_name ()); + return retval; +} + +Octave_map +octave_base_value::map_value (void) const +{ + Octave_map retval; + gripe_wrong_type_arg ("octave_base_value::map_value()", type_name ()); + return retval; +} + +octave_value +octave_base_value::not (void) const +{ + octave_value retval; + gripe_wrong_type_arg ("octave_base_value::not()", type_name ()); + return retval; +} + +octave_value +octave_base_value::uminus (void) const +{ + octave_value retval; + gripe_wrong_type_arg ("octave_base_value::uminus()", type_name ()); + return retval; +} + +octave_value +octave_base_value::transpose (void) const +{ + octave_value retval; + gripe_wrong_type_arg ("octave_base_value::transpose()", type_name ()); + return retval; +} + +octave_value +octave_base_value::hermitian (void) const +{ + octave_value retval; + gripe_wrong_type_arg ("octave_base_value::hermitian()", type_name ()); + return retval; +} + +void +octave_base_value::increment (void) +{ + gripe_wrong_type_arg ("octave_base_value::increment()", type_name ()); +} + +void +octave_base_value::decrement (void) +{ + gripe_wrong_type_arg ("octave_base_value::decrement()", type_name ()); +} + +static octave_value * +matrix_conv (const octave_value&) +{ + return new octave_matrix (); +} + +static octave_value * +complex_matrix_conv (const octave_value&) +{ + return new octave_complex_matrix (); +} + +static octave_value * +string_conv (const octave_value&) +{ + return new octave_char_matrix_str (); +} + +void +install_base_type_conversions (void) +{ + INSTALL_ASSIGNCONV (octave_base_value, octave_scalar, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_matrix, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_complex, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_complex_matrix, octave_complex_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_range, octave_matrix); + INSTALL_ASSIGNCONV (octave_base_value, octave_char_matrix_str, octave_char_matrix_str); + + INSTALL_WIDENOP (octave_base_value, octave_matrix, matrix_conv); + INSTALL_WIDENOP (octave_base_value, octave_complex_matrix, complex_matrix_conv); + INSTALL_WIDENOP (octave_base_value, octave_char_matrix_str, string_conv); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-base.h @@ -0,0 +1,195 @@ +/* + +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 (octave_base_value_h) +#define octave_base_value_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_base_value : public octave_value +{ +public: + + octave_base_value (void) + : octave_value (octave_xvalue ()) { } + + octave_base_value (const octave_base_value&) + : octave_value (octave_xvalue ()) { } + + ~octave_base_value (void) { } + + octave_value *clone (void) { return new octave_base_value (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + numeric_conv_fcn numeric_conversion_function (void) const + { return (numeric_conv_fcn) 0; } + + octave_value index (const octave_value_list& idx) const; + + idx_vector index_vector (void) const; + + octave_value struct_elt_val (const string& nm) const; + + octave_value& struct_elt_ref (const string& nm); + + int rows (void) const { return -1; } + + int columns (void) const { return -1; } + + bool is_defined (void) const { return false; } + + bool is_real_scalar (void) const { return false; } + + bool is_real_matrix (void) const { return false; } + + bool is_complex_scalar (void) const { return false; } + + bool is_complex_matrix (void) const { return false; } + + bool is_char_matrix (void) const { return false; } + + bool is_string (void) const { return false; } + + bool is_range (void) const { return false; } + + bool is_map (void) const { return false; } + + bool is_magic_colon (void) const { return false; } + + bool is_all_va_args (void) const { return false; } + + octave_value all (void) const { return 0.0; } + + octave_value any (void) const { return 0.0; } + + bool is_real_type (void) const { return false; } + + bool is_complex_type (void) const { return false; } + + // Would be nice to get rid of the next four functions: + + bool is_scalar_type (void) const { return false; } + + bool is_matrix_type (void) const { return false; } + + bool is_numeric_type (void) const { return false; } + + bool valid_as_scalar_index (void) const { return false; } + + bool valid_as_zero_index (void) const { return false; } + + bool is_true (void) const { return false; } + + bool is_empty (void) const + { return (rows () == 0 || columns () == 0); } + + bool is_zero_by_zero (void) const + { return (rows () == 0 && columns () == 0); } + + double double_value (bool) const; + + Matrix matrix_value (bool frc_str_conv = false) const; + + Complex complex_value (bool frc_str_conv = false) const; + + ComplexMatrix complex_matrix_value (bool frc_str_conv = false) const; + + charMatrix char_matrix_value (bool frc_str_conv = false) const; + + charMatrix all_strings (void) const; + + string string_value (void) const; + + Range range_value (void) const; + + Octave_map map_value (void) const; + + octave_value not (void) const; + + octave_value uminus (void) const; + + octave_value transpose (void) const; + + octave_value hermitian (void) const; + + void increment (void); + + void decrement (void); + + octave_value convert_to_str (void) const; + + void convert_to_row_or_column_vector (void); + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + static int t_id; + + static const string t_name; +}; + +#endif + +extern void install_base_type_conversions (void); + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-ch-mat.cc @@ -0,0 +1,107 @@ +/* + +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 "lo-ieee.h" +#include "mx-base.h" + +#include "ov-ch-mat.h" +#include "gripes.h" +#include "pr-output.h" + +int octave_char_matrix::t_id = -1; + +const string octave_char_matrix::t_name ("char matrix"); + +bool +octave_char_matrix::valid_as_scalar_index (void) const +{ + // XXX FIXME XXX + return false; +} + +bool +octave_char_matrix::valid_as_zero_index (void) const +{ + // XXX FIXME XXX + return false; +} + +bool +octave_char_matrix::is_true (void) const +{ + // XXX FIXME XXX + return false; + +#if 0 + Matrix m = (matrix.all ()) . all (); + + return (m.rows () == 1 && m.columns () == 1 && m (0, 0) != 0.0); +#endif +} + +double +octave_char_matrix::double_value (bool) const +{ + double retval = octave_NaN; + + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = matrix (0, 0); + else + gripe_invalid_conversion ("character matrix", "real scalar"); + + return retval; +} + +Complex +octave_char_matrix::complex_value (bool) const +{ + Complex retval (octave_NaN, octave_NaN); + + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = matrix (0, 0); + else + gripe_invalid_conversion ("character matrix", "complex scalar"); + + return retval; +} + +void +octave_char_matrix::print (ostream& os) +{ + octave_print_internal (os, matrix, false, struct_indent); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-ch-mat.h @@ -0,0 +1,140 @@ +/* + +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 (octave_char_matrix_h) +#define octave_char_matrix_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_char_matrix : public octave_base_value +{ +public: + + octave_char_matrix (void) + : octave_base_value () { } + + octave_char_matrix (const charMatrix& chm, bool = false) + : octave_base_value (), matrix (chm) { } + + octave_char_matrix (const char *s) + : octave_base_value (), matrix (s) { } + + octave_char_matrix (const string& s) + : octave_base_value (), matrix (s) { } + + octave_char_matrix (const string_vector& s) + : octave_base_value (), matrix (s) { } + + octave_char_matrix (const octave_char_matrix& chm) + : octave_base_value (), matrix (chm.matrix) { } + + ~octave_char_matrix (void) { } + + octave_value *clone (void) { return new octave_char_matrix (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + int rows (void) const { return matrix.rows (); } + int columns (void) const { return matrix.columns (); } + + bool is_defined (void) const { return true; } + + bool is_char_matrix (void) const { return true; } + + // XXX FIXME XXX + octave_value all (void) const { return false; } + octave_value any (void) const { return false; } + + bool is_real_type (void) const { return true; } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool valid_as_scalar_index (void) const; + bool valid_as_zero_index (void) const; + + bool is_true (void) const; + + double double_value (bool = false) const; + + Matrix matrix_value (bool = false) const { return matrix; } + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const { return matrix; } + + charMatrix char_matrix_value (bool = false) const { return matrix; } + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +protected: + + charMatrix matrix; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-colon.cc @@ -0,0 +1,43 @@ +/* + +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 "error.h" +#include "pr-output.h" +#include "ov-colon.h" + +int octave_magic_colon::t_id = -1; + +const string octave_magic_colon::t_name ("magic-colon"); + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-colon.h @@ -0,0 +1,98 @@ +/* + +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 (octave_magic_colon_h) +#define octave_magic_colon_h 1 + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_magic_colon : public octave_base_value +{ +public: + + octave_magic_colon (void) + : octave_base_value () { } + + octave_magic_colon (const octave_magic_colon&) + : octave_base_value () { } + + ~octave_magic_colon (void) { } + + octave_value *clone (void) { return new octave_magic_colon (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + idx_vector index_vector (void) const { return idx_vector (':'); } + + bool is_defined (void) const { return true; } + + bool is_magic_colon (void) const { return true; } + + bool valid_as_scalar_index (void) const { return true; } + + bool valid_as_zero_index (void) const { return false; } + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-complex.cc @@ -0,0 +1,142 @@ +/* + +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 "lo-ieee.h" + +#include "oct-obj.h" +#include "ov-complex.h" +#include "gripes.h" +#include "pr-output.h" + +int octave_complex::t_id = -1; + +const string octave_complex::t_name ("complex scalar"); + +static inline bool +valid_scalar_indices (const octave_value_list& args) +{ + int nargin = args.length (); + + for (int i = 0; i < nargin; i++) + if (! args(i).valid_as_scalar_index ()) + return false; + + return true; +} + +octave_value +octave_complex::index (const octave_value_list& idx) const +{ + octave_value retval; + + if (valid_scalar_indices (idx)) + retval = scalar; + else + { + // XXX FIXME XXX -- this doesn't solve the problem of + // + // a = i; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + octave_value tmp (complex_matrix_value ()); + + retval = tmp.index (idx); + } + + return retval; +} + +double +octave_complex::double_value (bool force_conversion) const +{ + double retval = octave_NaN; + + int flag = force_conversion; + + if (! flag) + flag = Vok_to_lose_imaginary_part; + + if (flag < 0) + gripe_implicit_conversion ("complex scalar", "real scalar"); + + if (flag) + retval = ::real (scalar); + else + gripe_invalid_conversion ("complex scalar", "real scalar"); + + return retval; +} + +Matrix +octave_complex::matrix_value (bool force_conversion) const +{ + Matrix retval; + + int flag = force_conversion; + + if (! flag) + flag = Vok_to_lose_imaginary_part; + + if (flag < 0) + gripe_implicit_conversion ("complex scalar", "real matrix"); + + if (flag) + retval = Matrix (1, 1, ::real (scalar)); + else + gripe_invalid_conversion ("complex scalar", "real matrix"); + + return retval; +} + +Complex +octave_complex::complex_value (bool) const +{ + return scalar; +} + + +ComplexMatrix +octave_complex::complex_matrix_value (bool) const +{ + return ComplexMatrix (1, 1, scalar); +} + +void +octave_complex::print (ostream& os) +{ + octave_print_internal (os, scalar, false); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-complex.h @@ -0,0 +1,145 @@ +/* + +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 (octave_complex_h) +#define octave_complex_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_complex : public octave_base_value +{ +public: + + octave_complex (void) + : octave_base_value () { } + + octave_complex (const Complex& c) + : octave_base_value (), scalar (c) { } + + octave_complex (const octave_complex& c) + : octave_base_value (), scalar (c.scalar) { } + + ~octave_complex (void) { } + + octave_value *clone (void) { return new octave_complex (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + octave_value index (const octave_value_list& idx) const; + + int rows (void) const { return 1; } + int columns (void) const { return 1; } + + bool is_defined (void) const { return true; } + + bool is_complex_scalar (void) const { return true; } + + octave_value all (void) const { return (scalar != 0.0); } + octave_value any (void) const { return (scalar != 0.0); } + + bool is_complex_type (void) const { return true; } + + bool is_scalar_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + // XXX FIXME XXX ??? + bool valid_as_scalar_index (void) const { return false; } + bool valid_as_zero_index (void) const { return false; } + + bool is_true (void) const { return (scalar != 0.0); } + + bool is_empty (void) const { return (rows () == 0 && columns () == 0); } + + double double_value (bool = false) const; + + Matrix matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + octave_value not (void) const { return octave_value (scalar == 0.0); } + + octave_value uminus (void) const { return octave_value (- scalar); } + + octave_value transpose (void) const { return octave_value (scalar); } + + octave_value hermitian (void) const { return octave_value (conj (scalar)); } + + void increment (void) { scalar += 1.0; } + + void decrement (void) { scalar -= 1.0; } + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + Complex scalar; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-cx-mat.cc @@ -0,0 +1,281 @@ +/* + +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 "lo-ieee.h" +#include "mx-base.h" + +#include "gripes.h" +#include "oct-obj.h" +#include "ov-cx-mat.h" +#include "pr-output.h" + +int octave_complex_matrix::t_id = -1; + +const string octave_complex_matrix::t_name ("complex matrix"); + +octave_complex_matrix::octave_complex_matrix (const ComplexRowVector& v, + int pcv) + : octave_base_value (), + matrix ((pcv < 0 && Vprefer_column_vectors) || pcv + ? ComplexMatrix (v.transpose ()) : ComplexMatrix (v)) { } + +octave_complex_matrix::octave_complex_matrix (const ComplexColumnVector& v, + int pcv) + : octave_base_value (), + matrix ((pcv < 0 && Vprefer_column_vectors) || pcv + ? ComplexMatrix (v) : ComplexMatrix (v.transpose ())) { } + +extern void assign (Array2<Complex>&, const Array2<Complex>&); + +octave_value +octave_complex_matrix::index (const octave_value_list& idx) const +{ + octave_value retval; + + int len = idx.length (); + + switch (len) + { + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + retval = ComplexMatrix (matrix.index (i, j)); + } + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + retval = ComplexMatrix (matrix.index (i)); + } + break; + + default: + error ("invalid number of indices (%d) for complex matrix value", len); + break; + } + + return retval; +} + +void +octave_complex_matrix::assign (const octave_value_list& idx, + const ComplexMatrix& rhs) +{ + int len = idx.length (); + + switch (len) + { + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + + matrix.set_index (i); + matrix.set_index (j); + + ::assign (matrix, rhs); + } + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + matrix.set_index (i); + + ::assign (matrix, rhs); + } + break; + + default: + error ("invalid number of indices (%d) for indexed matrix assignment", + len); + break; + } +} + +extern void assign (Array2<Complex>&, const Array2<double>&); + +void +octave_complex_matrix::assign (const octave_value_list& idx, + const Matrix& rhs) +{ + int len = idx.length (); + + switch (len) + { + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + + matrix.set_index (i); + matrix.set_index (j); + + ::assign (matrix, rhs); + } + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + matrix.set_index (i); + + ::assign (matrix, rhs); + } + break; + + default: + error ("invalid number of indices (%d) for indexed matrix assignment", + len); + break; + } +} + +bool +octave_complex_matrix::valid_as_scalar_index (void) const +{ + // XXX FIXME XXX + return false; +} + +bool +octave_complex_matrix::valid_as_zero_index (void) const +{ + // XXX FIXME XXX + return false; +} + +bool +octave_complex_matrix::is_true (void) const +{ + bool retval = false; + + if (rows () == 0 || columns () == 0) + { + int flag = Vpropagate_empty_matrices; + + if (flag < 0) + warning ("empty matrix used in conditional expression"); + else if (flag == 0) + error ("empty matrix used in conditional expression"); + } + else + { + Matrix m = (matrix.all ()) . all (); + + retval = (m.rows () == 1 && m.columns () == 1 && m (0, 0) != 0.0); + } + + return retval; +} + +double +octave_complex_matrix::double_value (bool force_conversion) const +{ + double retval = octave_NaN; + + int flag = force_conversion; + + if (! flag) + flag = Vok_to_lose_imaginary_part; + + if (flag < 0) + gripe_implicit_conversion ("complex matrix", "real scalar"); + + if (flag) + { + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = ::real (matrix (0, 0)); + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + } + else + gripe_invalid_conversion ("complex matrix", "real scalar"); + + return retval; +} + +Matrix +octave_complex_matrix::matrix_value (bool force_conversion) const +{ + Matrix retval; + + int flag = force_conversion; + + if (! flag) + flag = Vok_to_lose_imaginary_part; + + if (flag < 0) + gripe_implicit_conversion ("complex matrix", "real matrix"); + + if (flag) + retval = ::real (matrix); + else + gripe_invalid_conversion ("complex matrix", "real matrix"); + + return retval; +} + +Complex +octave_complex_matrix::complex_value (bool) const +{ + Complex retval (octave_NaN, octave_NaN); + + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = matrix (0, 0); + else + gripe_invalid_conversion ("complex matrix", "complex scalar"); + + return retval; +} + +ComplexMatrix +octave_complex_matrix::complex_matrix_value (bool) const +{ + return matrix; +} + +void +octave_complex_matrix::print (ostream& os) +{ + octave_print_internal (os, matrix, false, struct_indent); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-cx-mat.h @@ -0,0 +1,157 @@ +/* + +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 (octave_complex_matrix_h) +#define octave_complex_matrix_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_complex_matrix : public octave_base_value +{ +public: + + octave_complex_matrix (void) + : octave_base_value () { } + + octave_complex_matrix (const ComplexMatrix& m) + : octave_base_value (), matrix (m) { } + + octave_complex_matrix (const ComplexDiagMatrix& d) + : octave_base_value (), matrix (d) { } + + octave_complex_matrix (const ComplexRowVector& v, int pcv = -1); + + octave_complex_matrix (const ComplexColumnVector& v, int pcv = -1); + + octave_complex_matrix (const octave_complex_matrix& cm) + : octave_base_value (), matrix (cm.matrix) { } + + ~octave_complex_matrix (void) { } + + octave_value *clone (void) { return new octave_complex_matrix (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + octave_value index (const octave_value_list& idx) const; + + void assign (const octave_value_list& idx, const ComplexMatrix& rhs); + + void assign (const octave_value_list& idx, const Matrix& rhs); + + int rows (void) const { return matrix.rows (); } + int columns (void) const { return matrix.columns (); } + + bool is_defined (void) const { return true; } + + bool is_complex_matrix (void) const { return true; } + + octave_value all (void) const { return matrix.all (); } + octave_value any (void) const { return matrix.any (); } + + bool is_complex_type (void) const { return true; } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool valid_as_scalar_index (void) const; + bool valid_as_zero_index (void) const; + + bool is_true (void) const; + + bool is_empty (void) const { return (rows () == 0 && columns () == 0); } + + double double_value (bool) const; + + Matrix matrix_value (bool = false) const; + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const; + + octave_value not (void) const { return octave_value (! matrix); } + + octave_value uminus (void) const { return octave_value (- matrix); } + + octave_value transpose (void) const + { return octave_value (matrix.transpose ()); } + + octave_value hermitian (void) const + { return octave_value (matrix.hermitian ()); } + + void increment (void) { matrix += 1.0; } + + void decrement (void) { matrix -= 1.0; } + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + ComplexMatrix matrix; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-range.cc @@ -0,0 +1,136 @@ +/* + +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 "lo-ieee.h" +#include "lo-utils.h" + +#include "gripes.h" +#include "ops.h" +#include "ov-range.h" +#include "ov-re-mat.h" +#include "pr-output.h" + +int octave_range::t_id = -1; + +const string octave_range::t_name ("range"); + +static octave_value * +default_numeric_conversion_function (const octave_value& a) +{ + CAST_CONV_ARG (const octave_range&); + + return new octave_matrix (v.matrix_value ()); +} + +octave_value::numeric_conv_fcn +octave_range::numeric_conversion_function (void) const +{ + return default_numeric_conversion_function; +} + +double +octave_range::double_value (bool) const +{ + double retval = octave_NaN; + + int nel = range.nelem (); + + if (nel == 1 || (nel > 1 && Vdo_fortran_indexing)) + retval = range.base (); + else + gripe_invalid_conversion ("range", "real scalar"); + + return retval; +} + +octave_value +octave_range::all (void) const +{ + octave_value retval; + error ("octave_range::all(): not implemented"); + return retval; +} + +octave_value +octave_range::any (void) const +{ + octave_value retval; + error ("octave_range::any(): not implemented"); + return retval; +} + +bool +octave_range::is_true (void) const +{ + bool retval = false; + error ("octave_range::is_true(): not implemented"); + return retval; +} + +Complex +octave_range::complex_value (bool) const +{ + Complex retval (octave_NaN, octave_NaN); + + int nel = range.nelem (); + + if (nel == 1 || (nel > 1 && Vdo_fortran_indexing)) + retval = range.base (); + else + gripe_invalid_conversion ("range", "complex scalar"); + + return retval; +} + +octave_value +octave_range::transpose (void) const +{ + Matrix tmp (matrix_value ()); + return tmp.transpose (); +} + +octave_value +octave_range::hermitian (void) const +{ + Matrix tmp (matrix_value ()); + return tmp.transpose (); +} + +void +octave_range::print (ostream& os) +{ + octave_print_internal (os, range, false, struct_indent); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-range.h @@ -0,0 +1,164 @@ +/* + +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 (octave_range_h) +#define octave_range_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "Range.h" + +#include "lo-utils.h" +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "mappers.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Range values. + +class +octave_range : public octave_base_value +{ +public: + + octave_range (void) + : octave_base_value () { } + + octave_range (double base, double limit, double inc) + : octave_base_value (), range (base, limit, inc) + { + if (range.nelem () < 0) + ::error ("invalid range"); + } + + octave_range (const Range& r) + : octave_base_value (), range (r) + { + if (range.nelem () < 0) + ::error ("invalid range"); + } + + octave_range (const octave_range& r) + : octave_base_value (), range (r.range) { } + + ~octave_range (void) { } + + octave_value *clone (void) { return new octave_range (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + numeric_conv_fcn numeric_conversion_function (void) const; + + idx_vector index_vector (void) const { return idx_vector (range); } + + int rows (void) const { return (columns () > 0); } + int columns (void) const { return range.nelem (); } + + bool is_defined (void) const { return true; } + + bool is_range (void) const { return true; } + + // XXX DO ME XXX + octave_value all (void) const; + octave_value any (void) const; + + bool is_real_type (void) const { return true; } + + bool valid_as_scalar_index (void) const + { + return (range.nelem () == 1 + && ! xisnan (range.base ()) + && NINT (range.base ()) == 1); + } + + bool valid_as_zero_index (void) const + { + return (range.nelem () == 1 + && ! xisnan (range.base ()) + && NINT (range.base ()) == 0); + } + + // XXX DO ME XXX + bool is_true (void) const; + + double double_value (bool) const; + + Matrix matrix_value (bool) const + { return range.matrix_value (); } + + Complex complex_value (bool) const; + + ComplexMatrix complex_matrix_value (bool) const + { return range.matrix_value (); } + + Range range_value (void) const { return range; } + + octave_value transpose (void) const; + + octave_value hermitian (void) const; + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + Range range; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-re-mat.cc @@ -0,0 +1,250 @@ +/* + +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 "lo-ieee.h" +#include "lo-utils.h" +#include "mx-base.h" + +#include "gripes.h" +#include "mappers.h" +#include "oct-obj.h" +#include "ov-re-mat.h" +#include "pr-output.h" + +int octave_matrix::t_id = -1; + +const string octave_matrix::t_name ("matrix"); + +octave_matrix::octave_matrix (const RowVector& v, int pcv) + : octave_base_value (), + matrix ((pcv < 0 && Vprefer_column_vectors) || pcv + ? Matrix (v.transpose ()) : Matrix (v)) { } + +octave_matrix::octave_matrix (const ColumnVector& v, int pcv) + : octave_base_value (), + matrix ((pcv < 0 && Vprefer_column_vectors) || pcv + ? Matrix (v) : Matrix (v.transpose ())) { } + +#include <iostream.h> + +octave_value +octave_matrix::index (const octave_value_list& idx) const +{ + octave_value retval; + + int len = idx.length (); + + switch (len) + { + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + retval = Matrix (matrix.index (i, j)); + } + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + retval = Matrix (matrix.index (i)); + } + break; + + default: + error ("invalid number of indices (%d) for matrix value", len); + break; + } + + return retval; +} + +extern void assign (Array2<double>&, const Array2<double>&); + +void +octave_matrix::assign (const octave_value_list& idx, const Matrix& rhs) +{ + int len = idx.length (); + + switch (len) + { + case 2: + { + idx_vector i = idx (0).index_vector (); + idx_vector j = idx (1).index_vector (); + + matrix.set_index (i); + matrix.set_index (j); + + ::assign (matrix, rhs); + } + break; + + case 1: + { + idx_vector i = idx (0).index_vector (); + + matrix.set_index (i); + + ::assign (matrix, rhs); + } + break; + + default: + error ("invalid number of indices (%d) for indexed matrix assignment", + len); + break; + } +} + +bool +octave_matrix::valid_as_scalar_index (void) const +{ + // XXX FIXME XXX + return false; +} + +bool +octave_matrix::is_true (void) const +{ + bool retval = false; + + if (rows () == 0 || columns () == 0) + { + int flag = Vpropagate_empty_matrices; + + if (flag < 0) + warning ("empty matrix used in conditional expression"); + else if (flag == 0) + error ("empty matrix used in conditional expression"); + } + else + { + Matrix m = (matrix.all ()) . all (); + + retval = (m.rows () == 1 && m.columns () == 1 && m (0, 0) != 0.0); + } + + return retval; +} + +double +octave_matrix::double_value (bool) const +{ + double retval = octave_NaN; + + // XXX FIXME XXX -- maybe this should be a function, valid_as_scalar() + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = matrix (0, 0); + else + gripe_invalid_conversion ("real matrix", "real scalar"); + + return retval; +} + +Complex +octave_matrix::complex_value (bool) const +{ + Complex retval (octave_NaN, octave_NaN); + + if ((rows () == 1 && columns () == 1) + || (Vdo_fortran_indexing && rows () > 0 && columns () > 0)) + retval = matrix (0, 0); + else + gripe_invalid_conversion ("real matrix", "complex scalar"); + + return retval; +} + +octave_value +octave_matrix::convert_to_str (void) const +{ + octave_value retval; + + int nr = matrix.rows (); + int nc = matrix.columns (); + + if (nr == 0 && nc == 0) + { + char s = '\0'; + retval = octave_value (&s); + } + else + { + if (nr == 0 || nc == 0) + { + char s = '\0'; + retval = octave_value (&s); + } + else + { + charMatrix chm (nr, nc); + + for (int j = 0; j < nc; j++) + { + for (int i = 0; i < nr; i++) + { + double d = matrix (i, j); + + if (xisnan (d)) + { + ::error ("invalid conversion from NaN to character"); + return retval; + } + else + { + // XXX FIXME XXX -- warn about out of range + // conversions? + + int ival = NINT (d); + chm (i, j) = (char) ival; + } + } + } + + retval = octave_value (chm, 1); + } + } + + return retval; +} + +void +octave_matrix::print (ostream& os) +{ + octave_print_internal (os, matrix, false, struct_indent); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-re-mat.h @@ -0,0 +1,158 @@ +/* + +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 (octave_matrix_h) +#define octave_matrix_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real matrix values. + +class +octave_matrix : public octave_base_value +{ +public: + + octave_matrix (void) + : octave_base_value () { } + + octave_matrix (const Matrix& m) + : octave_base_value (), matrix (m) { } + + octave_matrix (const DiagMatrix& d) + : octave_base_value (), matrix (d) { } + + octave_matrix (const RowVector& v, int pcv = -1); + + octave_matrix (const ColumnVector& v, int pcv = -1); + + octave_matrix (const octave_matrix& m) + : octave_base_value (), matrix (m.matrix) { } + + ~octave_matrix (void) { } + + octave_value *clone (void) { return new octave_matrix (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + octave_value index (const octave_value_list& idx) const; + + void assign (const octave_value_list& idx, const Matrix& rhs); + + idx_vector index_vector (void) const { return idx_vector (matrix); } + + int rows (void) const { return matrix.rows (); } + int columns (void) const { return matrix.columns (); } + + bool is_defined (void) const { return true; } + + bool is_real_matrix (void) const { return true; } + + octave_value all (void) const { return matrix.all (); } + octave_value any (void) const { return matrix.any (); } + + bool is_real_type (void) const { return true; } + + bool is_matrix_type (void) const { return true; } + + bool is_numeric_type (void) const { return true; } + + bool valid_as_scalar_index (void) const; + + bool valid_as_zero_index (void) const { return is_zero_by_zero (); } + + bool is_true (void) const; + + double double_value (bool = false) const; + + Matrix matrix_value (bool = false) const { return matrix; } + + Complex complex_value (bool = false) const; + + ComplexMatrix complex_matrix_value (bool = false) const { return matrix; } + + octave_value not (void) const { return octave_value (! matrix); } + + octave_value uminus (void) const { return octave_value (- matrix); } + + octave_value transpose (void) const + { return octave_value (matrix.transpose ()); } + + octave_value hermitian (void) const + { return octave_value (matrix.transpose ()); } + + void increment (void) { matrix += 1.0; } + + void decrement (void) { matrix -= 1.0; } + + octave_value convert_to_str (void) const; + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + Matrix matrix; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-scalar.cc @@ -0,0 +1,110 @@ +/* + +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 "defun.h" +#include "gripes.h" +#include "oct-obj.h" +#include "ov-scalar.h" +#include "ov-typeinfo.h" +#include "pr-output.h" +#include "xdiv.h" +#include "xpow.h" + +int octave_scalar::t_id = -1; + +const string octave_scalar::t_name ("scalar"); + +static inline bool +valid_scalar_indices (const octave_value_list& args) +{ + int nargin = args.length (); + + for (int i = 0; i < nargin; i++) + if (! args(i).valid_as_scalar_index ()) + return false; + + return true; +} + +octave_value +octave_scalar::index (const octave_value_list& idx) const +{ + octave_value retval; + + if (valid_scalar_indices (idx)) + retval = scalar; + else + { + // XXX FIXME XXX -- this doesn't solve the problem of + // + // a = 1; a([1,1], [1,1], [1,1]) + // + // and similar constructions. Hmm... + + octave_value tmp (matrix_value ()); + + retval = tmp.index (idx); + } + + return retval; +} + +octave_value +octave_scalar::convert_to_str (void) const +{ + octave_value retval; + + if (xisnan (scalar)) + ::error ("invalid conversion from NaN to character"); + else + { + // XXX FIXME XXX -- warn about out of range conversions? + + int i = NINT (scalar); + char s[2]; + s[0] = (char) i; + s[1] = '\0'; + retval = octave_value (s); + } + + return retval; +} + +void +octave_scalar::print (ostream& os) +{ + octave_print_internal (os, scalar, false); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-scalar.h @@ -0,0 +1,148 @@ +/* + +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 (octave_scalar_h) +#define octave_scalar_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "lo-utils.h" +#include "mx-base.h" +#include "str-vec.h" + +#include "mappers.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_scalar : public octave_base_value +{ +public: + + octave_scalar (void) + : octave_base_value (), scalar (0.0) { } + + octave_scalar (double d) + : octave_base_value (), scalar (d) { } + + octave_scalar (const octave_scalar& s) + : octave_base_value (), scalar (s.scalar) { } + + ~octave_scalar (void) { } + + octave_value *clone (void) { return new octave_scalar (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + octave_value index (const octave_value_list& idx) const; + + idx_vector index_vector (void) const { return idx_vector (scalar); } + + int rows (void) const { return 1; } + int columns (void) const { return 1; } + + bool is_defined (void) const { return true; } + bool is_real_scalar (void) const { return true; } + + octave_value all (void) const { return (scalar != 0.0); } + octave_value any (void) const { return (scalar != 0.0); } + + bool is_real_type (void) const { return true; } + bool is_scalar_type (void) const { return true; } + bool is_numeric_type (void) const { return true; } + + bool valid_as_scalar_index (void) const + { return (! xisnan (scalar) && NINT (scalar) == 1); } + + bool valid_as_zero_index (void) const + { return (! xisnan (scalar) && NINT (scalar) == 0); } + + bool is_true (void) const { return (scalar != 0.0); } + + double double_value (bool = false) const { return scalar; } + + Matrix matrix_value (bool = false) const { return Matrix (1, 1, scalar); } + + Complex complex_value (bool = false) const { return scalar; } + + ComplexMatrix complex_matrix_value (bool = false) const + { return ComplexMatrix (1, 1, Complex (scalar)); } + + octave_value not (void) const { return octave_value (! scalar); } + + octave_value uminus (void) const { return octave_value (- scalar); } + + octave_value transpose (void) const { return octave_value (scalar); } + + octave_value hermitian (void) const { return octave_value (scalar); } + + void increment (void) { ++scalar; } + + void decrement (void) { --scalar; } + + octave_value convert_to_str (void) const; + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + double scalar; + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-str-mat.cc @@ -0,0 +1,142 @@ +/* + +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 "lo-ieee.h" +#include "mx-base.h" + +#include "ops.h" +#include "ov-re-mat.h" +#include "ov-str-mat.h" +#include "gripes.h" +#include "pr-output.h" + +int octave_char_matrix_str::t_id = -1; + +const string octave_char_matrix_str::t_name ("string"); + +static octave_value * +default_numeric_conversion_function (const octave_value& a) +{ + CAST_CONV_ARG (const octave_char_matrix_str&); + + return new octave_matrix (v.matrix_value ()); +} + +octave_value::numeric_conv_fcn +octave_char_matrix_str::numeric_conversion_function (void) const +{ + return default_numeric_conversion_function; +} + +octave_value +octave_char_matrix_str::all (void) const +{ + octave_value retval; + error ("octave_char_matrix_str::all(): not implemented"); + return retval; +} + +octave_value +octave_char_matrix_str::any (void) const +{ + octave_value retval; + error ("octave_char_matrix_str::any(): not implemented"); + return retval; +} + +bool +octave_char_matrix_str::valid_as_scalar_index (void) const +{ + bool retval = false; + error ("octave_char_matrix_str::valid_as_scalar_index(): not implemented"); + return retval; +} +bool +octave_char_matrix_str::valid_as_zero_index (void) const +{ + bool retval = false; + error ("octave_char_matrix_str::valid_as_zero_index(): not implemented"); + return retval; +} + +bool +octave_char_matrix_str::is_true (void) const +{ + bool retval = false; + error ("octave_char_matrix_str::is_true(): not implemented"); + return retval; +} + +Matrix +octave_char_matrix_str::matrix_value (bool force_string_conv) const +{ + Matrix retval; + + int flag = force_string_conv; + + if (! flag) + flag = Vimplicit_str_to_num_ok; + + if (flag < 0) + gripe_implicit_conversion ("string", "real matrix"); + + if (flag) + retval = Matrix (matrix); + else + gripe_invalid_conversion ("string", "real matrix"); + + return retval; +} + +charMatrix +octave_char_matrix_str::all_strings (void) const +{ + charMatrix retval; + error ("octave_char_matrix_str::all_strings(): not implemented"); + return retval; +} + +string +octave_char_matrix_str::string_value (void) const +{ + return matrix.row_as_string (0); // XXX FIXME??? XXX +} + +void +octave_char_matrix_str::print (ostream& os) +{ + octave_print_internal (os, matrix, false, true, struct_indent); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-str-mat.h @@ -0,0 +1,131 @@ +/* + +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 (octave_char_matrix_str_h) +#define octave_char_matrix_str_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-ch-mat.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_char_matrix_str : public octave_char_matrix +{ +public: + + octave_char_matrix_str (void) + : octave_char_matrix () { } + + octave_char_matrix_str (const charMatrix& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (const char *s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const string& s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const string_vector& s) + : octave_char_matrix (s) { } + + octave_char_matrix_str (const octave_char_matrix& chm) + : octave_char_matrix (chm) { } + + octave_char_matrix_str (const octave_char_matrix_str& chms) + : octave_char_matrix (chms) { } + + ~octave_char_matrix_str (void) { } + + octave_value *clone (void) { return new octave_char_matrix_str (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + numeric_conv_fcn numeric_conversion_function (void) const; + + octave_value all (void) const; + octave_value any (void) const; + + bool is_string (void) const { return true; } + + bool is_real_type (void) const { return true; } + + bool valid_as_scalar_index (void) const; + bool valid_as_zero_index (void) const; + + bool is_true (void) const; + + Matrix matrix_value (bool = false) const; + + charMatrix char_matrix_value (bool = false) const { return matrix; } + + charMatrix all_strings (void) const; + + string string_value (void) const; + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-struct.cc @@ -0,0 +1,222 @@ +/* + +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 <iostream.h> + +#include "error.h" +#include "ov-struct.h" +#include "unwind-prot.h" + +int octave_struct::t_id = -1; + +const string octave_struct::t_name ("struct"); + + +octave_value +octave_struct::struct_elt_val (const string& nm) const +{ + octave_value retval; + + Pix idx = map.seek (nm); + + if (idx) + retval = map.contents (idx); + else + error ("structure has no member `%s'", nm.c_str ()); + + return retval; +} + +octave_value& +octave_struct::struct_elt_ref (const string& nm) +{ + return map [nm]; + +#if 0 + static octave_value fooval; + + Pix idx = map.seek (nm); + + if (idx) + return map.contents (idx); + else if (insert) + return map [nm]; + else + error ("structure has no member `%s'", nm.c_str ()); + + return fooval; +#endif +} + +#if 0 +octave_value& +octave_struct::lookup_map_element (const string& name, bool insert, + bool silent) +{ + static octave_value fooval; + + Pix idx = map.seek (name); + + if (idx) + return map.contents (idx); + else if (insert) + return map [name]; + else if (! silent) + error ("structure has no member `%s'", name.c_str ()); + + return fooval; +} + +octave_value +octave_struct::lookup_map_element (const string& ref, bool insert, + bool silent) +{ + octave_value retval; + + if (! ref.empty ()) + { + SLList<string> list; + + size_t beg = 0; + size_t end; + + do + { + end = ref.find ('.', beg); + + string tmp = (end == NPOS) + ? ref.substr (beg) : ref.substr (beg, end - beg); + + list.append (tmp); + } + while (end != NPOS && (beg = end + 1)); + + retval = lookup_map_element (list, insert, silent); + } + + return retval; +} + +octave_value +octave_struct::lookup_map_element (SLList<string>& list, bool insert, + bool silent) +{ + octave_value retval; + + Pix p = list.first (); + + while (p) + { + string elt = list (p); + + list.next (p); + + octave_value tmp = lookup_map_element (elt, insert, silent); + + if (error_state) + break; + + tmp_rep = tmp.rep; + + if (! p) + retval = tmp; + } + + return retval; +} +#endif + +void +octave_struct::print (ostream& os) +{ + // XXX FIXME XXX -- would be nice to print the output in some + // standard order. Maybe all substructures first, maybe + // alphabetize entries, etc. + + begin_unwind_frame ("octave_struct_print"); + + unwind_protect_int (struct_indent); + unwind_protect_int (Vstruct_levels_to_print); + + if (Vstruct_levels_to_print-- > 0) + { + os.form ("\n%*s{\n", struct_indent, ""); + + increment_struct_indent (); + + Pix p = map.first (); + + while (p) + { + bool pad_after = false; + + string key = map.key (p); + octave_value val = map.contents (p); + + map.next (p); + + os.form ("%*s%s =", struct_indent, "", key.c_str ()); + + if (val.print_as_scalar ()) + os << " "; + else if (val.print_as_structure ()) + { + if (p) + pad_after = true; + } + else + { + if (p) + pad_after = true; + + os << "\n\n"; + } + + val.print (os); + + if (pad_after) + os << "\n"; + } + + decrement_struct_indent (); + + os.form ("%*s%s", struct_indent, "", "}\n"); + } + else + os << " <structure>\n"; + + run_unwind_frame ("octave_struct_print"); +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-struct.h @@ -0,0 +1,197 @@ +/* + +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 (octave_struct_h) +#define octave_struct_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "oct-map.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_struct : public octave_base_value +{ +public: + + octave_struct (void) + : octave_base_value () { } + + octave_struct (const Octave_map& m) + : octave_base_value (), map (m) { } + + octave_struct (const octave_struct& s) + : octave_base_value (), map (s.map) { } + + ~octave_struct (void) { } + + octave_value *clone (void) { return new octave_struct (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + octave_value struct_elt_val (const string& nm) const; + + octave_value& struct_elt_ref (const string& nm); + + bool is_defined (void) const { return true; } + + bool is_map (void) const { return true; } + +#if 0 + double double_value (bool) const + Matrix matrix_value (bool frc_str_conv = false) const; + Complex complex_value (bool frc_str_conv = false) const; + ComplexMatrix complex_matrix_value (bool frc_str_conv = false) const; + charMatrix char_matrix_value (bool frc_str_conv = false) const; + charMatrix all_strings (void) const; + string string_value (void) const; + Range range_value (void) const +#endif + + Octave_map map_value (void) const { return map; } + +#if 0 + octave_value& lookup_map_element (const string& name, + bool insert = false, + bool silent = false); + + octave_value& lookup_map_element (SLList<string>& name, + bool insert = false, + bool silent = false); + + ColumnVector vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + ComplexColumnVector + complex_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + octave_value convert_to_str (void) const; + + void convert_to_row_or_column_vector (void); + + void maybe_mutate (void); +#endif + + void print (ostream& os); + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +#if 0 + // Binary and unary operations. + + friend octave_value do_binary_op (octave_value& a, octave_value& b, + tree_expression::type t); + + friend octave_value do_unary_op (octave_value& a, + tree_expression::type t); + + // We want to eliminate this. + + constant_type const_type (void) const { return type_tag; } + + // We want to get rid of these too: + + void force_numeric (bool frc_str_conv = false); + octave_value make_numeric (bool frc_str_conv = false) const; + + // But not this. + + void convert_to_matrix_type (bool make_complex); + + // Indexing and assignment. + + void clear_index (void); + + // void set_index (double d); + void set_index (const Range& r); + void set_index (const ColumnVector& v); + void set_index (const Matrix& m); + void set_index (char c); + + void set_index (const octave_value_list& args, + bool rhs_is_complex = false); + + octave_value do_index (const octave_value_list& args); + + void maybe_widen (constant_type t); + + void assign (octave_value& rhs, const octave_value_list& args); + + bool print_as_scalar (void); + + bool print_as_structure (void); +#endif + +private: + + Octave_map map; + + static int t_id; + + static const string t_name; + +#if 0 + // For custom memory management. + // XXX FIXME XXX -- maybe this should be inherited (use void* and cast). + + octave_base_value *freeptr; +#endif +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-typeinfo.cc @@ -0,0 +1,232 @@ +/* + +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 "ov-typeinfo.h" + +#include "defun.h" +#include "error.h" +#include "help.h" +#include "oct-obj.h" + +octave_value_typeinfo *octave_value_typeinfo::instance = 0; + +#include <Array.cc> +#include <Array2.cc> +#include <Array3.cc> + +template class Array<octave_value::binary_op_fcn>; +template class Array2<octave_value::binary_op_fcn>; +template class Array3<octave_value::binary_op_fcn>; + +template class Array<octave_value::assign_op_fcn>; +template class Array2<octave_value::assign_op_fcn>; + +template class Array<octave_value::widening_op_fcn>; +template class Array2<octave_value::widening_op_fcn>; + +int +octave_value_typeinfo::register_type (const string& name) +{ + if (! instance) + instance = new octave_value_typeinfo (); + + return instance->do_register_type (name); +} + +bool +octave_value_typeinfo::register_binary_op (octave_value::binary_op op, + int t1, int t2, + octave_value::binary_op_fcn f) +{ + if (! instance) + instance = new octave_value_typeinfo (); + + return instance->do_register_binary_op (op, t1, t2, f); +} + +bool +octave_value_typeinfo::register_assign_op (int t_lhs, int t_rhs, + octave_value::assign_op_fcn f) +{ + if (! instance) + instance = new octave_value_typeinfo (); + + return instance->do_register_assign_op (t_lhs, t_rhs, f); +} + +bool +octave_value_typeinfo::register_pref_assign_conv (int t_lhs, int t_rhs, + int t_result) +{ + if (! instance) + instance = new octave_value_typeinfo (); + + return instance->do_register_pref_assign_conv (t_lhs, t_rhs, t_result); +} + +bool +octave_value_typeinfo::register_widening_op (int t, int t_result, + octave_value::widening_op_fcn f) +{ + if (! instance) + instance = new octave_value_typeinfo (); + + return instance->do_register_widening_op (t, t_result, f); +} + +int +octave_value_typeinfo::do_register_type (const string& name) +{ + int i = 0; + + for (i = 0; i < num_types; i++) + if (name == types (i)) + return i; + + int len = types.length (); + + if (i == len) + { + len *= 2; + + types.resize (len, string ()); + + binary_ops.resize ((int) octave_value::num_binary_ops, len, len, + (octave_value::binary_op_fcn) 0); + + assign_ops.resize (len, len, (octave_value::assign_op_fcn) 0); + + pref_assign_conv.resize (len, len, -1); + + widening_ops.resize (len, len, (octave_value::widening_op_fcn) 0); + } + + types (i) = name; + + num_types++; + + return i; +} + +bool +octave_value_typeinfo::do_register_binary_op (octave_value::binary_op op, + int t1, int t2, + octave_value::binary_op_fcn f) +{ + binary_ops.checkelem ((int) op, t1, t2) = f; + + return false; +} + +bool +octave_value_typeinfo::do_register_assign_op (int t_lhs, int t_rhs, + octave_value::assign_op_fcn f) +{ + assign_ops.checkelem (t_lhs, t_rhs) = f; + + return false; +} + +bool +octave_value_typeinfo::do_register_pref_assign_conv (int t_lhs, int t_rhs, + int t_result) +{ + pref_assign_conv.checkelem (t_lhs, t_rhs) = t_result; + + return false; +} + +bool +octave_value_typeinfo::do_register_widening_op + (int t, int t_result, octave_value::widening_op_fcn f) +{ + widening_ops.checkelem (t, t_result) = f; + + return false; +} + +#include <iostream.h> + +octave_value::binary_op_fcn +octave_value_typeinfo::do_lookup_binary_op (octave_value::binary_op op, + int t1, int t2) +{ + return binary_ops.checkelem ((int) op, t1, t2); +} + +octave_value::assign_op_fcn +octave_value_typeinfo::do_lookup_assign_op (int t_lhs, int t_rhs) +{ + return assign_ops.checkelem (t_lhs, t_rhs); +} + +int +octave_value_typeinfo::do_lookup_pref_assign_conv (int t_lhs, int t_rhs) +{ + return pref_assign_conv.checkelem (t_lhs, t_rhs); +} + +octave_value::widening_op_fcn +octave_value_typeinfo::do_lookup_widening_op (int t, int t_result) +{ + return widening_ops.checkelem (t, t_result); +} + +string_vector +octave_value_typeinfo::do_installed_type_names (void) +{ + string_vector retval (num_types); + + for (int i = 0;i < num_types; i++) + retval (i) = types (i); + + return retval; +} + +DEFUN(typeinfo, args, , + "usage: typeinfo ([typename])") +{ + octave_value retval; + + int nargin = args.length (); + + if (nargin == 0) + retval = octave_value_typeinfo::installed_type_names (); + else + print_usage ("typeinfo"); + + return retval; +} + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-typeinfo.h @@ -0,0 +1,146 @@ +/* + +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 (octave_value_typeinfo_h) +#define octave_value_typeinfo_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <string> + +#include "Array.h" +#include "Array2.h" +#include "Array3.h" + +#include "ov.h" + +class string_vector; + +class +octave_value_typeinfo +{ +public: + + static int register_type (const string&); + + static bool register_binary_op (octave_value::binary_op, int, int, + octave_value::binary_op_fcn); + + static bool register_assign_op (int, int, octave_value::assign_op_fcn); + + static bool register_pref_assign_conv (int, int, int); + + static bool register_widening_op (int, int, octave_value::widening_op_fcn); + + static octave_value::binary_op_fcn + lookup_binary_op (octave_value::binary_op op, int t1, int t2) + { + return instance->do_lookup_binary_op (op, t1, t2); + } + + static octave_value::assign_op_fcn + lookup_assign_op (int t_lhs, int t_rhs) + { + return instance->do_lookup_assign_op (t_lhs, t_rhs); + } + + static int + lookup_pref_assign_conv (int t_lhs, int t_rhs) + { + return instance->do_lookup_pref_assign_conv (t_lhs, t_rhs); + } + + static octave_value::widening_op_fcn + lookup_widening_op (int t, int t_result) + { + return instance->do_lookup_widening_op (t, t_result); + } + + static string_vector installed_type_names (void) + { + return instance->do_installed_type_names (); + } + +protected: + + octave_value_typeinfo (void) + : num_types (0), types (32, string ()), + binary_ops (octave_value::num_binary_ops, 32, 32, + (octave_value::binary_op_fcn) 0), + assign_ops (32, 32, (octave_value::assign_op_fcn) 0), + pref_assign_conv (32, 32, -1), + widening_ops (32, 32, (octave_value::widening_op_fcn) 0) { } + +private: + + static octave_value_typeinfo *instance; + + int num_types; + + Array<string> types; + + Array3<octave_value::binary_op_fcn> binary_ops; + + Array2<octave_value::assign_op_fcn> assign_ops; + + Array2<int> pref_assign_conv; + + Array2<octave_value::widening_op_fcn> widening_ops; + + int do_register_type (const string&); + + bool do_register_binary_op (octave_value::binary_op, int, int, + octave_value::binary_op_fcn); + + bool do_register_assign_op (int, int, octave_value::assign_op_fcn); + + bool do_register_pref_assign_conv (int, int, int); + + bool do_register_widening_op (int, int, octave_value::widening_op_fcn); + + octave_value::binary_op_fcn + do_lookup_binary_op (octave_value::binary_op, int, int); + + octave_value::assign_op_fcn do_lookup_assign_op (int, int); + + int do_lookup_pref_assign_conv (int, int); + + octave_value::widening_op_fcn do_lookup_widening_op (int, int); + + string_vector do_installed_type_names (void); + + // No copying! + + octave_value_typeinfo (const octave_value_typeinfo&); + + octave_value_typeinfo& operator = (const octave_value_typeinfo&); +}; + +#endif + +/* +;; Local Variables: *** +;; mode: C++ *** +;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-va-args.cc @@ -0,0 +1,43 @@ +/* + +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 "error.h" +#include "pr-output.h" +#include "ov-va-args.h" + +int octave_all_va_args::t_id = -1; + +const string octave_all_va_args::t_name ("va-arg"); + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov-va-args.h @@ -0,0 +1,92 @@ +/* + +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 (octave_all_va_args_h) +#define octave_all_va_args_h 1 + +#include <cstdlib> + +#include <string> + +class ostream; + +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "ov-base.h" +#include "ov-typeinfo.h" + +class Octave_map; +class octave_value_list; + +class tree_walker; + +// Real scalar values. + +class +octave_all_va_args : public octave_base_value +{ +public: + + octave_all_va_args (void) + : octave_base_value () { } + + octave_all_va_args (const octave_all_va_args&) + : octave_base_value () { } + + ~octave_all_va_args (void) { } + + octave_value *clone (void) { return new octave_all_va_args (*this); } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + bool is_defined (void) const { return true; } + + bool is_all_va_args (void) const { return true; } + + int type_id (void) const { return t_id; } + + string type_name (void) const { return t_name; } + + static int static_type_id (void) { return t_id; } + + static void register_type (void) + { t_id = octave_value_typeinfo::register_type (t_name); } + +private: + + static int t_id; + + static const string t_name; +}; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
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: *** +*/
new file mode 100644 --- /dev/null +++ b/src/ov.h @@ -0,0 +1,527 @@ +/* + +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 (octave_value_h) +#define octave_value_h 1 + +#if defined (__GNUG__) +#pragma interface +#endif + +#include <cstdlib> + +#include <string> + +class ostream; + +#include <SLList.h> + +#include "Range.h" +#include "idx-vector.h" +#include "mx-base.h" +#include "str-vec.h" + +#include "error.h" +#include "pt-exp.h" + +class Octave_map; +class octave_value_list; + +// Constants. + +// This just provides a way to avoid infinite recursion when building +// octave_value objects. + +class +octave_xvalue +{ +public: + + octave_xvalue (void) { } +}; + +class +octave_value +{ +public: + + typedef octave_value (*binary_op_fcn) + (const octave_value&, const octave_value&); + + typedef octave_value (*assign_op_fcn) + (octave_value&, const octave_value_list&, const octave_value&); + + typedef octave_value * (*widening_op_fcn) (const octave_value&); + + typedef octave_value * (*numeric_conv_fcn) (const octave_value&); + + enum binary_op + { + add, + sub, + mul, + div, + pow, + ldiv, + lt, + le, + eq, + ge, + gt, + ne, + el_mul, + el_div, + el_pow, + el_ldiv, + el_and, + el_or, + struct_ref, + num_binary_ops, + unknown_binary_op + }; + + static string binary_op_as_string (binary_op); + + enum magic_colon { magic_colon_t }; + enum all_va_args { all_va_args_t }; + + octave_value (void); + octave_value (double d); + octave_value (const Matrix& m); + octave_value (const DiagMatrix& d); + octave_value (const RowVector& v, int pcv = -1); + octave_value (const ColumnVector& v, int pcv = -1); + octave_value (const Complex& C); + octave_value (const ComplexMatrix& m); + octave_value (const ComplexDiagMatrix& d); + octave_value (const ComplexRowVector& v, int pcv = -1); + octave_value (const ComplexColumnVector& v, int pcv = -1); + octave_value (const char *s); + octave_value (const string& s); + octave_value (const string_vector& s); + octave_value (const charMatrix& chm, bool is_string = false); + octave_value (double base, double limit, double inc); + octave_value (const Range& r); + octave_value (const Octave_map& m); + octave_value (octave_value::magic_colon); + octave_value (octave_value::all_va_args); + + octave_value (octave_value *new_rep); + + // Copy constructor. + + octave_value (const octave_value& a) + { + rep = a.rep; + rep->count++; + } + + // Delete the representation of this constant if the count drops to + // zero. + + virtual ~octave_value (void); + + // This should only be called for derived types. + + virtual octave_value *clone (void) { panic_impossible (); } + + void make_unique (void) + { + if (rep->count > 1) + { + --rep->count; + rep = rep->clone (); + rep->count = 1; + } + } + +#if 0 + void *operator new (size_t size); + void operator delete (void *p, size_t size); +#endif + + // Simple assignment. + + octave_value& operator = (const octave_value& a) + { + if (rep != a.rep) + { + if (--rep->count == 0) + delete rep; + + rep = a.rep; + rep->count++; + } + + return *this; + } + + virtual numeric_conv_fcn numeric_conversion_function (void) const + { return rep->numeric_conversion_function (); } + + virtual octave_value index (const octave_value_list& idx) const + { return rep->index (idx); } + + octave_value& assign (const octave_value_list& idx, const octave_value& rhs); + + virtual idx_vector index_vector (void) const + { return rep->index_vector (); } + + virtual octave_value struct_elt_val (const string& nm) const + { return rep->struct_elt_val (nm); } + + virtual octave_value& struct_elt_ref (const string& nm) + { return rep->struct_elt_ref (nm); } + +#if 0 + // Simple structure assignment. + + octave_value assign_map_element (SLList<string>& list, + octave_value& rhs); + + // Indexed structure assignment. + + octave_value assign_map_element (SLList<string>& list, + octave_value& rhs, + const octave_value_list& args); +#endif + + // Size. + + virtual int rows (void) const + { return rep->rows (); } + + virtual int columns (void) const + { return rep->columns (); } + + // Does this constant have a type? Both of these are provided since + // it is sometimes more natural to write is_undefined() instead of + // ! is_defined(). + + virtual bool is_defined (void) const + { return rep->is_defined (); } + + bool is_undefined (void) const + { return ! is_defined (); } + + virtual bool is_real_scalar (void) const + { return rep->is_real_scalar (); } + + virtual bool is_real_matrix (void) const + { return rep->is_real_matrix (); } + + virtual bool is_complex_scalar (void) const + { return rep->is_complex_scalar (); } + + virtual bool is_complex_matrix (void) const + { return rep->is_complex_matrix (); } + + virtual bool is_char_matrix (void) const + { return rep->is_char_matrix (); } + + virtual bool is_string (void) const + { return rep->is_string (); } + + virtual bool is_range (void) const + { return rep->is_range (); } + + virtual bool is_map (void) const + { return rep->is_map (); } + + virtual bool is_magic_colon (void) const + { return rep->is_magic_colon (); } + + virtual bool is_all_va_args (void) const + { return rep->is_all_va_args (); } + + // Are any or all of the elements in this constant nonzero? + + virtual octave_value all (void) const + { return rep->all (); } + + virtual octave_value any (void) const + { return rep->any (); } + + // Other type stuff. + + virtual bool is_real_type (void) const + { return rep->is_real_type (); } + + virtual bool is_complex_type (void) const + { return rep->is_complex_type (); } + + virtual bool is_scalar_type (void) const + { return rep->is_scalar_type (); } + + virtual bool is_matrix_type (void) const + { return rep->is_matrix_type (); } + + virtual bool is_numeric_type (void) const + { return rep->is_numeric_type (); } + + virtual bool valid_as_scalar_index (void) const + { return rep->valid_as_scalar_index (); } + + virtual bool valid_as_zero_index (void) const + { return rep->valid_as_zero_index (); } + + // Does this constant correspond to a truth value? + + virtual bool is_true (void) const + { return rep->is_true (); } + + // Is at least one of the dimensions of this constant zero? + + virtual bool is_empty (void) const + { return rep->is_empty (); } + + // Are the dimensions of this constant zero by zero? + + virtual bool is_zero_by_zero (void) const + { return rep->is_zero_by_zero (); } + + // Values. + + virtual double double_value (bool frc_str_conv = false) const + { return rep->double_value (frc_str_conv); } + + virtual Matrix matrix_value (bool frc_str_conv = false) const + { return rep->matrix_value (frc_str_conv); } + + virtual Complex complex_value (bool frc_str_conv = false) const + { return rep->complex_value (frc_str_conv); } + + virtual ComplexMatrix complex_matrix_value (bool frc_str_conv = false) const + { return rep->complex_matrix_value (frc_str_conv); } + + virtual charMatrix char_matrix_value (bool frc_str_conv = false) const + { return rep->char_matrix_value (frc_str_conv); } + + virtual charMatrix all_strings (void) const + { return rep->all_strings (); } + + virtual string string_value (void) const + { return rep->string_value (); } + + virtual Range range_value (void) const + { return rep->range_value (); } + + virtual Octave_map map_value (void) const; + + // Unary ops. + + virtual octave_value not (void) const { return rep->not (); } + + virtual octave_value uminus (void) const { return rep->uminus (); } + + virtual octave_value transpose (void) const { return rep->transpose (); } + + virtual octave_value hermitian (void) const { return rep->hermitian (); } + + virtual void increment (void) + { + make_unique (); + rep->increment (); + } + + virtual void decrement (void) + { + make_unique (); + rep->decrement (); + } + +#if 0 + virtual octave_value + lookup_map_element (const string& ref, bool insert = false, + bool silent = false) + { return lookup_map_element (ref, insert, silent); } + + virtual octave_value + lookup_map_element (SLList<string>& list, bool insert = false, + bool silent = false) + { return rep->lookup_map_element (list, insert, silent); } +#endif + + ColumnVector vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + ComplexColumnVector + complex_vector_value (bool frc_str_conv = false, + bool frc_vec_conv = false) const; + + // Conversions. These should probably be private. If a user of this + // class wants a certain kind of constant, he should simply ask for + // it, and we should convert it if possible. + + virtual octave_value convert_to_str (void) const + { return rep->convert_to_str (); } + + virtual void convert_to_row_or_column_vector (void) + { rep->convert_to_row_or_column_vector (); } + + void print (void); + + virtual void print (ostream& os) { rep->print (os); } + + void print_with_name (const string& name, bool print_padding = true); + + void print_with_name (ostream& os, const string& name, + bool print_padding = true); + + virtual int type_id (void) const { return rep->type_id (); } + + virtual string type_name (void) const { return rep->type_name (); } + +#if 0 + octave_value_rep *make_unique_map (void); + + // We want to eliminate this, or at least make it private. + + virtual octave_value_rep::constant_type const_type (void) const + { return rep->const_type (); } +#endif + + virtual void convert_to_matrix_type (bool make_complex) + { rep->convert_to_matrix_type (make_complex); } + + // Can we make these go away? + + // These need better names, since a range really is a numeric type. + + virtual void force_numeric (bool frc_str_conv = false) + { rep->force_numeric (frc_str_conv); } + + octave_value make_numeric (bool) const + { + warning ("octave_value::make_numeric() is a no-op"); + return *this; + } + +#if 0 + { + if (is_numeric_type ()) + return *this; + else + return rep->make_numeric (frc_str_conv); + } +#endif + + bool print_as_scalar (void); + + bool print_as_structure (void) { return is_map (); } + + // Binary and unary operations. + + friend octave_value do_binary_op (octave_value& a, octave_value& b, + tree_expression::type t); + +protected: + + octave_value (const octave_xvalue&) : rep (0) { } + +private: + + union + { + octave_value *freeptr; // For custom memory management. + octave_value *rep; // The real representation. + int count; // A reference count. + }; +}; + +// If TRUE, allow assignments like +// +// octave> A(1) = 3; A(2) = 5 +// +// for A already defined and a matrix type. +extern 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. +extern 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. +extern 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. +extern 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). +extern bool Vprefer_zero_one_indexing; + +// If TRUE, print the name along with the value. +extern 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. +extern int Vpropagate_empty_matrices; + +// If TRUE, resize matrices when performing and indexed assignment and +// the indices are outside the current bounds. +extern bool Vresize_on_range_error; + +// How many levels of structure elements should we print? +extern int Vstruct_levels_to_print; + +// Allow divide by zero errors to be suppressed. +extern bool Vwarn_divide_by_zero; + +// Indentation level for structures. +extern int struct_indent; + +extern void symbols_of_value (void); + +extern void increment_struct_indent (void); +extern void decrement_struct_indent (void); + +extern octave_value +do_binary_op (octave_value::binary_op, const octave_value&, + const octave_value&); + +extern void install_types (void); + +#endif + +/* +;; Local Variables: *** +;; mode: C++ *** +;; End: *** +*/