Mercurial > hg > octave-nkf
changeset 767:42731861ee09
[project @ 1994-10-05 21:26:54 by jwe]
author | jwe |
---|---|
date | Wed, 05 Oct 1994 21:32:24 +0000 |
parents | b70e0404a8da |
children | 4b36f97e86cf |
files | src/arith-ops.cc src/data.cc src/lex.l src/load-save.cc src/mappers.cc src/parse.y src/pt-const.h src/pt-exp-base.cc src/symtab.cc src/symtab.h src/sysdep.cc src/tc-assign.cc src/tc-rep.cc src/tc-rep.h src/xdiv.cc src/xpow.cc |
diffstat | 16 files changed, 726 insertions(+), 854 deletions(-) [+] |
line wrap: on
line diff
--- a/src/arith-ops.cc +++ b/src/arith-ops.cc @@ -74,9 +74,8 @@ Matrix_OR, }; -/* - * Check row and column dimensions for binary matrix operations. - */ +// Check row and column dimensions for binary matrix operations. + static inline int m_add_conform (const Matrix& a, const Matrix& b, int warn) { @@ -197,23 +196,21 @@ return ok; } -/* - * Stupid binary comparison operations like the ones Matlab provides. - * One for each type combination, in the order given here: - * - * op2 \ op1: s m cs cm - * +-- +---+---+----+----+ - * scalar | | * | 3 | * | 9 | - * +---+---+----+----+ - * matrix | 1 | 4 | 7 | 10 | - * +---+---+----+----+ - * complex_scalar | * | 5 | * | 11 | - * +---+---+----+----+ - * complex_matrix | 2 | 6 | 8 | 12 | - * +---+---+----+----+ - */ +// Stupid binary comparison operations like the ones Matlab provides. +// One for each type combination, in the order given here: +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// matrix | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_matrix | 2 | 6 | 8 | 12 | +// +---+---+----+----+ -/* 1 */ +// -*- 1 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, double s, const Matrix& a) { @@ -268,7 +265,7 @@ return t; } -/* 2 */ +// -*- 2 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, double s, const ComplexMatrix& a) { @@ -323,7 +320,7 @@ return t; } -/* 3 */ +// -*- 3 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Matrix& a, double s) { @@ -378,7 +375,7 @@ return t; } -/* 4 */ +// -*- 4 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Matrix& a, const Complex& s) { @@ -433,7 +430,7 @@ return t; } -/* 5 */ +// -*- 5 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Matrix& a, const Matrix& b) { @@ -491,7 +488,7 @@ return c; } -/* 6 */ +// -*- 6 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Matrix& a, const ComplexMatrix& b) { @@ -548,7 +545,7 @@ return c; } -/* 7 */ +// -*- 7 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Complex& s, const Matrix& a) { @@ -603,7 +600,7 @@ return t; } -/* 8 */ +// -*- 8 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const Complex& s, const ComplexMatrix& a) { @@ -658,7 +655,7 @@ return t; } -/* 9 */ +// -*- 9 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const ComplexMatrix& a, double s) { @@ -713,7 +710,7 @@ return t; } -/* 10 */ +// -*- 10 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const ComplexMatrix& a, const Complex& s) { @@ -768,7 +765,7 @@ return t; } -/* 11 */ +// -*- 11 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const ComplexMatrix& a, const Matrix& b) { @@ -825,7 +822,7 @@ return c; } -/* 12 */ +// -*- 12 -*- static Matrix mx_stupid_bool_op (Matrix_bool_op op, const ComplexMatrix& a, const ComplexMatrix& b) @@ -884,15 +881,12 @@ return c; } -/* - * Unary operations. One for each numeric data type: - * - * scalar - * complex_scalar - * matrix - * complex_matrix - * - */ +// Unary operations. One for each numeric data type: +// +// scalar +// complex_scalar +// matrix +// complex_matrix tree_constant do_unary_op (double d, tree_expression::type t) @@ -998,23 +992,21 @@ return tree_constant (result); } -/* - * Binary operations. One for each type combination, in the order - * given here: - * - * op2 \ op1: s m cs cm - * +-- +---+---+----+----+ - * scalar | | 1 | 5 | 9 | 13 | - * +---+---+----+----+ - * matrix | 2 | 6 | 10 | 14 | - * +---+---+----+----+ - * complex_scalar | 3 | 7 | 11 | 15 | - * +---+---+----+----+ - * complex_matrix | 4 | 8 | 12 | 16 | - * +---+---+----+----+ - */ +// Binary operations. One for each type combination, in the order +// given here: +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | 1 | 5 | 9 | 13 | +// +---+---+----+----+ +// matrix | 2 | 6 | 10 | 14 | +// +---+---+----+----+ +// complex_scalar | 3 | 7 | 11 | 15 | +// +---+---+----+----+ +// complex_matrix | 4 | 8 | 12 | 16 | +// +---+---+----+----+ -/* 1 */ +// -*- 1 -*- tree_constant do_binary_op (double a, double b, tree_expression::type t) { @@ -1083,7 +1075,7 @@ return tree_constant (result); } -/* 2 */ +// -*- 2 -*- tree_constant do_binary_op (double a, const Matrix& b, tree_expression::type t) { @@ -1154,7 +1146,7 @@ return tree_constant (result); } -/* 3 */ +// -*- 3 -*- tree_constant do_binary_op (double a, const Complex& b, tree_expression::type t) { @@ -1245,7 +1237,7 @@ return tree_constant (complex_result); } -/* 4 */ +// -*- 4 -*- tree_constant do_binary_op (double a, const ComplexMatrix& b, tree_expression::type t) { @@ -1336,7 +1328,7 @@ return tree_constant (complex_result); } -/* 5 */ +// -*- 5 -*- tree_constant do_binary_op (const Matrix& a, double b, tree_expression::type t) { @@ -1405,7 +1397,7 @@ return tree_constant (result); } -/* 6 */ +// -*- 6 -*- tree_constant do_binary_op (const Matrix& a, const Matrix& b, tree_expression::type t) { @@ -1493,7 +1485,7 @@ return tree_constant (result); } -/* 7 */ +// -*- 7 -*- tree_constant do_binary_op (const Matrix& a, const Complex& b, tree_expression::type t) { @@ -1583,7 +1575,7 @@ return tree_constant (complex_result); } -/* 8 */ +// -*- 8 -*- tree_constant do_binary_op (const Matrix& a, const ComplexMatrix& b, tree_expression::type t) { @@ -1694,7 +1686,7 @@ return tree_constant (complex_result); } -/* 9 */ +// -*- 9 -*- tree_constant do_binary_op (const Complex& a, double b, tree_expression::type t) { @@ -1785,7 +1777,7 @@ return tree_constant (complex_result); } -/* 10 */ +// -*- 10 -*- tree_constant do_binary_op (const Complex& a, const Matrix& b, tree_expression::type t) { @@ -1877,7 +1869,7 @@ return tree_constant (complex_result); } -/* 11 */ +// -*- 11 -*- tree_constant do_binary_op (const Complex& a, const Complex& b, tree_expression::type t) { @@ -1968,7 +1960,7 @@ return tree_constant (complex_result); } -/* 12 */ +// -*- 12 -*- tree_constant do_binary_op (const Complex& a, const ComplexMatrix& b, tree_expression::type t) @@ -2061,7 +2053,7 @@ return tree_constant (complex_result); } -/* 13 */ +// -*- 13 -*- tree_constant do_binary_op (const ComplexMatrix& a, double b, tree_expression::type t) { @@ -2151,7 +2143,7 @@ return tree_constant (complex_result); } -/* 14 */ +// -*- 14 -*- tree_constant do_binary_op (const ComplexMatrix& a, const Matrix& b, tree_expression::type t) { @@ -2262,7 +2254,7 @@ return tree_constant (complex_result); } -/* 15 */ +// -*- 15 -*- tree_constant do_binary_op (const ComplexMatrix& a, const Complex& b, tree_expression::type t) @@ -2353,7 +2345,7 @@ return tree_constant (complex_result); } -/* 16 */ +// -*- 16 -*- tree_constant do_binary_op (const ComplexMatrix& a, const ComplexMatrix& b, tree_expression::type t)
--- a/src/data.cc +++ b/src/data.cc @@ -44,6 +44,10 @@ #define MIN(a,b) ((a) < (b) ? (a) : (b)) #endif +#ifndef ABS +#define ABS(x) (((x) < 0) ? (-x) : (x)) +#endif + DEFUN ("all", Fall, Sall, 1, 1, "all (X): are all elements of X nonzero?") { @@ -288,6 +292,251 @@ return retval; } +static tree_constant +make_diag (const Matrix& v, int k) +{ + int nr = v.rows (); + int nc = v.columns (); + assert (nc == 1 || nr == 1); + + tree_constant retval; + + int roff = 0; + int coff = 0; + if (k > 0) + { + roff = 0; + coff = k; + } + else if (k < 0) + { + roff = -k; + coff = 0; + } + + if (nr == 1) + { + int n = nc + ABS (k); + Matrix m (n, n, 0.0); + for (int i = 0; i < nc; i++) + m.elem (i+roff, i+coff) = v.elem (0, i); + retval = tree_constant (m); + } + else + { + int n = nr + ABS (k); + Matrix m (n, n, 0.0); + for (int i = 0; i < nr; i++) + m.elem (i+roff, i+coff) = v.elem (i, 0); + retval = tree_constant (m); + } + + return retval; +} + +static tree_constant +make_diag (const ComplexMatrix& v, int k) +{ + int nr = v.rows (); + int nc = v.columns (); + assert (nc == 1 || nr == 1); + + tree_constant retval; + + int roff = 0; + int coff = 0; + if (k > 0) + { + roff = 0; + coff = k; + } + else if (k < 0) + { + roff = -k; + coff = 0; + } + + if (nr == 1) + { + int n = nc + ABS (k); + ComplexMatrix m (n, n, 0.0); + for (int i = 0; i < nc; i++) + m.elem (i+roff, i+coff) = v.elem (0, i); + retval = tree_constant (m); + } + else + { + int n = nr + ABS (k); + ComplexMatrix m (n, n, 0.0); + for (int i = 0; i < nr; i++) + m.elem (i+roff, i+coff) = v.elem (i, 0); + retval = tree_constant (m); + } + + return retval; +} + +static tree_constant +make_diag (const tree_constant& arg) +{ + tree_constant retval; + + if (arg.is_real_type ()) + { + Matrix m = arg.matrix_value (); + + if (! error_state) + { + int nr = m.rows (); + int nc = m.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else if (nr == 1 || nc == 1) + retval = make_diag (m, 0); + else + { + ColumnVector v = m.diag (); + if (v.capacity () > 0) + retval = v; + } + } + else + gripe_wrong_type_arg ("diag", arg); + } + else if (arg.is_complex_type ()) + { + ComplexMatrix cm = arg.complex_matrix_value (); + + if (! error_state) + { + int nr = cm.rows (); + int nc = cm.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else if (nr == 1 || nc == 1) + retval = make_diag (cm, 0); + else + { + ComplexColumnVector v = cm.diag (); + if (v.capacity () > 0) + retval = v; + } + } + else + gripe_wrong_type_arg ("diag", arg); + } + else + gripe_wrong_type_arg ("diag", arg); + + return retval; +} + +static tree_constant +make_diag (const tree_constant& a, const tree_constant& b) +{ + tree_constant retval; + + double tmp = b.double_value (); + + if (error_state) + { + error ("diag: invalid second argument"); + return retval; + } + + int k = NINT (tmp); + int n = ABS (k) + 1; + + if (a.is_real_type ()) + { + if (a.is_scalar_type ()) + { + double d = a.double_value (); + + if (k == 0) + retval = d; + else if (k > 0) + { + Matrix m (n, n, 0.0); + m.elem (0, k) = d; + retval = m; + } + else if (k < 0) + { + Matrix m (n, n, 0.0); + m.elem (-k, 0) = d; + retval = m; + } + } + else if (a.is_matrix_type ()) + { + Matrix m = a.matrix_value (); + + int nr = m.rows (); + int nc = m.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else if (nr == 1 || nc == 1) + retval = make_diag (m, k); + else + { + ColumnVector d = m.diag (k); + retval = d; + } + } + else + gripe_wrong_type_arg ("diag", a); + } + else if (a.is_complex_type ()) + { + if (a.is_scalar_type ()) + { + Complex c = a.complex_value (); + + if (k == 0) + retval = c; + else if (k > 0) + { + ComplexMatrix m (n, n, 0.0); + m.elem (0, k) = c; + retval = m; + } + else if (k < 0) + { + ComplexMatrix m (n, n, 0.0); + m.elem (-k, 0) = c; + retval = m; + } + } + else if (a.is_matrix_type ()) + { + ComplexMatrix cm = a.complex_matrix_value (); + + int nr = cm.rows (); + int nc = cm.columns (); + + if (nr == 0 || nc == 0) + retval = Matrix (); + else if (nr == 1 || nc == 1) + retval = make_diag (cm, k); + else + { + ComplexColumnVector d = cm.diag (k); + retval = d; + } + } + else + gripe_wrong_type_arg ("diag", a); + } + else + gripe_wrong_type_arg ("diag", a); + + return retval; +} + DEFUN ("diag", Fdiag, Sdiag, 2, 1, "diag (X [,k]): form/extract diagonals") { @@ -296,9 +545,9 @@ int nargin = args.length (); if (nargin == 1 && args(0).is_defined ()) - retval = args(0).diag (); + retval = make_diag (args(0)); else if (nargin == 2 && args(0).is_defined () && args(1).is_defined ()) - retval = args(0).diag (args(1)); + retval = make_diag (args(0), args(1)); else print_usage ("diag");
--- a/src/lex.l +++ b/src/lex.l @@ -625,12 +625,11 @@ %% -/* - * GAG. - * - * If we're reading a matrix and the next character is '[', make sure - * that we insert a comma ahead of it. - */ +// GAG. +// +// If we're reading a matrix and the next character is '[', make sure +// that we insert a comma ahead of it. + void do_comma_insert_check (void) { @@ -639,11 +638,10 @@ do_comma_insert = (braceflag && c == '['); } -/* - * Fix things up for errors or interrupts. The parser is never called - * recursively, so it is always safe to reinitialize its state before - * doing any parsing. - */ +// Fix things up for errors or interrupts. The parser is never called +// recursively, so it is always safe to reinitialize its state before +// doing any parsing. + void reset_parser (void) { @@ -712,9 +710,8 @@ yyrestart (stdin); } -/* - * Replace backslash escapes in a string with the real values. - */ +// Replace backslash escapes in a string with the real values. + static void do_string_escapes (char *s) { @@ -780,10 +777,9 @@ *p1 = '\0'; } -/* - * If we read some newlines, we need figure out what column we're - * really looking at. - */ +// If we read some newlines, we need figure out what column we're +// really looking at. + static void fixup_column_count (char *s) { @@ -797,9 +793,7 @@ } } -/* - * Include these so that we don't have to link to libfl.a. - */ +// Include these so that we don't have to link to libfl.a. #ifdef yywrap #undef yywrap @@ -810,10 +804,9 @@ return 1; } -/* - * These are not needed with flex-2.4.6, but may be needed with - * earlier 2.4.x versions. - */ +// These are not needed with flex-2.4.6, but may be needed with +// earlier 2.4.x versions. + #if 0 static void * yy_flex_alloc (int size) @@ -834,64 +827,57 @@ } #endif -/* - * Tell us all what the current buffer is. - */ +// Tell us all what the current buffer is. + YY_BUFFER_STATE current_buffer (void) { return YY_CURRENT_BUFFER; } -/* - * Create a new buffer. - */ +// Create a new buffer. + YY_BUFFER_STATE create_buffer (FILE *f) { return yy_create_buffer (f, YY_BUF_SIZE); } -/* - * Start reading a new buffer. - */ +// Start reading a new buffer. + void switch_to_buffer (YY_BUFFER_STATE buf) { yy_switch_to_buffer (buf); } -/* - * Delete a buffer. - */ +// Delete a buffer. + void delete_buffer (YY_BUFFER_STATE buf) { yy_delete_buffer (buf); } -/* - * Restore a buffer (for unwind-prot). - */ +// Restore a buffer (for unwind-prot). + void restore_input_buffer (void *buf) { switch_to_buffer ((YY_BUFFER_STATE) buf); } -/* - * Delete a buffer (for unwind-prot). - */ +// Delete a buffer (for unwind-prot). + void delete_input_buffer (void *buf) { delete_buffer ((YY_BUFFER_STATE) buf); } -/* - * Check to see if a character string matches any of the possible line - * styles for plots. - */ +// Check to see if a character string matches any of the possible line +// styles for plots. + static char * plot_style_token (char *s) { @@ -918,10 +904,9 @@ return 0; } -/* - * Check to see if a character string matches any one of the plot - * option keywords. - */ +// Check to see if a character string matches any one of the plot +// option keywords. + static int is_plot_keyword (char *s) { @@ -947,9 +932,8 @@ } } -/* - * Handle keywords. Could probably be more efficient... - */ +// Handle keywords. Could probably be more efficient... + static int is_keyword (char *s) { @@ -1118,19 +1102,17 @@ return 0; } -/* - * Try to find an identifier. All binding to global or builtin - * variables occurs when expressions are evaluated. - */ +// Try to find an identifier. All binding to global or builtin +// variables occurs when expressions are evaluated. + static symbol_record * lookup_identifier (char *name) { return curr_sym_tab->lookup (name, 1, 0); } -/* - * Grab the help text from an function file. - */ +// Grab the help text from an function file. + static void grab_help_text (void) { @@ -1179,10 +1161,9 @@ help_buf[len] = '\0'; } -/* - * Return 1 if the given character matches any character in the given - * string. - */ +// Return 1 if the given character matches any character in the given +// string. + static int match_any (char c, char *s) { @@ -1195,22 +1176,20 @@ return 0; } -/* - * Given information about the spacing surrounding an operator, - * return 1 if it looks like it should be treated as a binary - * operator. For example, - * - * [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary - */ +// Given information about the spacing surrounding an operator, +// return 1 if it looks like it should be treated as a binary +// operator. For example, +// +// [ 1 + 2 ] or [ 1+ 2] or [ 1+2 ] ==> binary + static int looks_like_bin_op (int spc_prev, int spc_next) { return ((spc_prev && spc_next) || ! spc_prev); } -/* - * Duh. - */ +// Duh. + static int next_char_is_space (void) { @@ -1219,10 +1198,9 @@ return (c == ' ' || c == '\t'); } -/* - * Try to determine if the next token should be treated as a postfix - * unary operator. This is ugly, but it seems to do the right thing. - */ +// Try to determine if the next token should be treated as a postfix +// unary operator. This is ugly, but it seems to do the right thing. + static int next_token_is_postfix_unary_op (int spc_prev, char *yytext) { @@ -1242,11 +1220,10 @@ return un_op; } -/* - * Try to determine if the next token should be treated as a binary - * operator. This is even uglier, but it also seems to do the right - * thing. - */ +// Try to determine if the next token should be treated as a binary +// operator. This is even uglier, but it also seems to do the right +// thing. + static int next_token_is_bin_op (int spc_prev, char *yytext) { @@ -1334,9 +1311,8 @@ return bin_op; } -/* - * Used to delete trailing white space from tokens. - */ +// Used to delete trailing white space from tokens. + static char * strip_trailing_whitespace (char *s) { @@ -1353,10 +1329,9 @@ return retval; } -/* - * Figure out exactly what kind of token to return when we have seen - * an identifier. Handles keywords. - */ +// Figure out exactly what kind of token to return when we have seen +// an identifier. Handles keywords. + static int handle_identifier (char *tok, int next_tok_is_eq) { @@ -1494,11 +1469,10 @@ return NAME; } -/* - * Print a warning if a function file that defines a function has - * anything other than comments and whitespace following the END token - * that matches the FUNCTION statement. - */ +// Print a warning if a function file that defines a function has +// anything other than comments and whitespace following the END token +// that matches the FUNCTION statement. + void check_for_garbage_after_fcn_def (void) { @@ -1542,7 +1516,9 @@ yyunput ('\n', yytext); } -/* Maybe someday... +/* + +Maybe someday... "+=" return ADD_EQ; "-=" return SUB_EQ;
--- a/src/load-save.cc +++ b/src/load-save.cc @@ -2705,8 +2705,12 @@ return retval; } - ostream stream; - ofstream file; +// Not declaring these static causes trouble on some systems with +// g++/libg++ iostream. Hmm. + + static ostream stream; + static ofstream file; + if (strcmp (*argv, "-") == 0) { // XXX FIXME XXX -- should things intended for the screen end up in a
--- a/src/mappers.cc +++ b/src/mappers.cc @@ -53,9 +53,7 @@ extern int signgam; #endif -/* - * Double -> double mappers. - */ +// Double -> double mappers. double arg (double x) @@ -184,9 +182,7 @@ #endif } -/* - * Complex -> double mappers. - */ +// Complex -> double mappers. double xisnan (const Complex& x) @@ -214,9 +210,7 @@ return (double) (! (int) xfinite (x)); } -/* - * Complex -> complex mappers. - */ +// Complex -> complex mappers. Complex acos (const Complex& x)
--- a/src/parse.y +++ b/src/parse.y @@ -22,9 +22,8 @@ // Parser for Octave. -/* - * C decarations. - */ +// C decarations. + %{ #define YYDEBUG 1
--- a/src/pt-const.h +++ b/src/pt-const.h @@ -361,23 +361,11 @@ // ------------------------------------------------------------------- -// These may not need to be member functions. - - tree_constant diag (void) const { return rep->diag (); } - tree_constant diag (const tree_constant& a) const { return rep->diag (a); } - - tree_constant mapper (Mapper_fcn& m_fcn, int print) const - { return rep->mapper (m_fcn, print); } - -// ------------------------------------------------------------------- - // We want to eliminate this, or at least make it private. tree_constant_rep::constant_type const_type (void) const { return rep->const_type (); } -// ------------------------------------------------------------------- - private: // Can we make these go away?
--- a/src/pt-exp-base.cc +++ b/src/pt-exp-base.cc @@ -91,6 +91,30 @@ #endif static int +any_element_less_than (const Matrix& a, double val) +{ + int nr = a.rows (); + int nc = a.columns (); + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + if (a.elem (i, j) < val) + return 1; + return 0; +} + +static int +any_element_greater_than (const Matrix& a, double val) +{ + int nr = a.rows (); + int nc = a.columns (); + for (int j = 0; j < nc; j++) + for (int i = 0; i < nr; i++) + if (a.elem (i, j) > val) + return 1; + return 0; +} + +static int print_as_scalar (const tree_constant& val) { int nr = val.rows (); @@ -2233,6 +2257,84 @@ return retval; } +static tree_constant +apply_mapper_fcn (const tree_constant& arg, Mapper_fcn& m_fcn, int print) +{ + tree_constant retval; + + if (arg.is_real_type ()) + { + if (arg.is_scalar_type ()) + { + double d = arg.double_value (); + + if (m_fcn.can_return_complex_for_real_arg + && (d < m_fcn.lower_limit || d > m_fcn.upper_limit)) + { + if (m_fcn.c_c_mapper) + retval = m_fcn.c_c_mapper (Complex (d)); + else + error ("%s: unable to handle real arguments", m_fcn.name); + } + else if (m_fcn.d_d_mapper) + retval = m_fcn.d_d_mapper (d); + else + error ("%s: unable to handle real arguments", m_fcn.name); + } + else if (arg.is_matrix_type ()) + { + Matrix m = arg.matrix_value (); + + if (m_fcn.can_return_complex_for_real_arg + && (any_element_less_than (m, m_fcn.lower_limit) + || any_element_greater_than (m, m_fcn.upper_limit))) + { + if (m_fcn.c_c_mapper) + retval = map (m_fcn.c_c_mapper, ComplexMatrix (m)); + else + error ("%s: unable to handle real arguments", m_fcn.name); + } + else if (m_fcn.d_d_mapper) + retval = map (m_fcn.d_d_mapper, m); + else + error ("%s: unable to handle real arguments", m_fcn.name); + } + else + gripe_wrong_type_arg ("mapper", arg); + } + else if (arg.is_complex_type ()) + { + if (arg.is_scalar_type ()) + { + Complex c = arg.complex_value (); + + if (m_fcn.d_c_mapper) + retval = m_fcn.d_c_mapper (c); + else if (m_fcn.c_c_mapper) + retval = m_fcn.c_c_mapper (c); + else + error ("%s: unable to handle complex arguments", m_fcn.name); + } + else if (arg.is_matrix_type ()) + { + ComplexMatrix cm = arg.complex_matrix_value (); + + if (m_fcn.d_c_mapper) + retval = map (m_fcn.d_c_mapper, cm); + else if (m_fcn.c_c_mapper) + retval = map (m_fcn.c_c_mapper, cm); + else + error ("%s: unable to handle complex arguments", m_fcn.name); + } + else + gripe_wrong_type_arg ("mapper", arg); + } + else + gripe_wrong_type_arg ("mapper", arg); + + return retval; +} + Octave_object tree_builtin::eval (int print, int nargout, const Octave_object& args) { @@ -2258,7 +2360,7 @@ ::error ("%s: too many arguments", my_name); else if (nargin > 0 && args(0).is_defined ()) { - tree_constant tmp = args(0).mapper (mapper_fcn, 0); + tree_constant tmp = apply_mapper_fcn (args(0), mapper_fcn, 0); retval(0) = tmp; } } @@ -2304,9 +2406,7 @@ if (param_list) { - int len = param_list->length (); - int va_only = param_list->varargs_only (); - num_named_args = va_only ? len - 1 : len; + num_named_args = param_list->length (); curr_va_arg_number = num_named_args; } @@ -2369,10 +2469,10 @@ tree_constant retval; if (curr_va_arg_number < num_args_passed) - retval = args_passed (++curr_va_arg_number); + retval = args_passed (curr_va_arg_number++); else - ::error ("error getting arg number %d -- only %d provided", - curr_va_arg_number, num_args_passed-1); + ::error ("va_arg: error getting arg number %d -- only %d provided", + curr_va_arg_number + 1, num_args_passed); return retval; }
--- a/src/symtab.cc +++ b/src/symtab.cc @@ -42,9 +42,8 @@ #include "fnmatch.h" } -/* - * Variables and functions. - */ +// Variables and functions. + symbol_def::symbol_def (void) { init_state (); @@ -212,9 +211,8 @@ return count; } -/* - * Individual records in a symbol table. - */ +// Individual records in a symbol table. + symbol_record::symbol_record (void) { init_state (); @@ -660,9 +658,7 @@ return top; } -/* - * A structure for handling verbose information about a symbol_record. - */ +// A structure for handling verbose information about a symbol_record. symbol_record_info::symbol_record_info (void) { @@ -846,9 +842,7 @@ nm = 0; } -/* - * A symbol table. - */ +// A symbol table. symbol_table::symbol_table (void) {
--- a/src/symtab.h +++ b/src/symtab.h @@ -34,7 +34,8 @@ class ostream; -#define HASH_TABLE_SIZE 1024 /* Must be multiple of 2 */ +// Must be multiple of 2. +#define HASH_TABLE_SIZE 1024 #define HASH_MASK (HASH_TABLE_SIZE - 1) class tree; @@ -48,9 +49,8 @@ class symbol_record_info; class symbol_table; -/* - * Variables or functions. - */ +// Variables or functions. + class symbol_def { friend class symbol_record; @@ -116,9 +116,8 @@ symbol_def& operator = (const symbol_def& sd); }; -/* - * Individual records in a symbol table. - */ +// Individual records in a symbol table. + class symbol_record { @@ -207,9 +206,7 @@ symbol_record& operator = (const symbol_record& s); }; -/* - * A structure for handling verbose information about a symbol_record. - */ +// A structure for handling verbose information about a symbol_record. class symbol_record_info @@ -270,9 +267,7 @@ int initialized; }; -/* - * A symbol table. - */ +// A symbol table. #define SYMTAB_LOCAL_SCOPE 1 #define SYMTAB_GLOBAL_SCOPE 2
--- a/src/sysdep.cc +++ b/src/sysdep.cc @@ -140,8 +140,6 @@ #endif #endif - - #if defined (HAVE_QUIET_NAN) octave_NaN = (double) quiet_nan (); #else @@ -168,7 +166,6 @@ #endif } - #if defined (EXCEPTION_IN_MATH) extern "C" { @@ -212,19 +209,18 @@ octave_ieee_init (); } -/* - * Set terminal in raw mode. From less-177. - * - * Change terminal to "raw mode", or restore to "normal" mode. - * "Raw mode" means - * 1. An outstanding read will complete on receipt of a single keystroke. - * 2. Input is not echoed. - * 3. On output, \n is mapped to \r\n. - * 4. \t is NOT expanded into spaces. - * 5. Signal-causing characters such as ctrl-C (interrupt), - * etc. are NOT disabled. - * It doesn't matter whether an input \n is mapped to \r, or vice versa. - */ +// Set terminal in raw mode. From less-177. +// +// Change terminal to "raw mode", or restore to "normal" mode. +// "Raw mode" means +// 1. An outstanding read will complete on receipt of a single keystroke. +// 2. Input is not echoed. +// 3. On output, \n is mapped to \r\n. +// 4. \t is NOT expanded into spaces. +// 5. Signal-causing characters such as ctrl-C (interrupt), +// etc. are NOT disabled. +// It doesn't matter whether an input \n is mapped to \r, or vice versa. + void raw_mode (int on) { @@ -360,9 +356,8 @@ curr_on = on; } -/* - * Read one character from the terminal. - */ +// Read one character from the terminal. + int kbhit (void) {
--- a/src/tc-assign.cc +++ b/src/tc-assign.cc @@ -34,11 +34,10 @@ #include "tc-inlines.cc" -/* - * Top-level tree-constant function that handles assignments. Only - * decide if the left-hand side is currently a scalar or a matrix and - * hand off to other functions to do the real work. - */ +// Top-level tree-constant function that handles assignments. Only +// decide if the left-hand side is currently a scalar or a matrix and +// hand off to other functions to do the real work. + void tree_constant_rep::assign (tree_constant& rhs, tree_constant *args, int nargs) { @@ -74,10 +73,9 @@ } } -/* - * Assignments to scalars. If resize_on_range_error is true, - * this can convert the left-hand size to a matrix. - */ +// Assignments to scalars. If resize_on_range_error is true, +// this can convert the left-hand size to a matrix. + void tree_constant_rep::do_scalar_assignment (tree_constant& rhs, tree_constant *args, int nargs) @@ -177,12 +175,11 @@ ::error ("index invalid or out of range for scalar type"); } -/* - * Assignments to matrices (and vectors). - * - * For compatibility with Matlab, we allow assignment of an empty - * matrix to an expression with empty indices to do nothing. - */ +// Assignments to matrices (and vectors). +// +// For compatibility with Matlab, we allow assignment of an empty +// matrix to an expression with empty indices to do nothing. + void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant *args, int nargs) @@ -251,9 +248,8 @@ } } -/* - * Matrix assignments indexed by a single value. - */ +// Matrix assignments indexed by a single value. + void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant& i_arg) @@ -295,11 +291,10 @@ ::error ("single index only valid for row or column vector"); } -/* - * Fortran-style assignments. Matrices are assumed to be stored in - * column-major order and it is ok to use a single index for - * multi-dimensional matrices. - */ +// Fortran-style assignments. Matrices are assumed to be stored in +// column-major order and it is ok to use a single index for +// multi-dimensional matrices. + void tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, tree_constant& i_arg) @@ -460,9 +455,8 @@ } } -/* - * Fortran-style assignment for vector index. - */ +// Fortran-style assignment for vector index. + void tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, idx_vector& i) @@ -505,9 +499,8 @@ ::error ("number of rows and columns must match for indexed assignment"); } -/* - * Fortran-style assignment for colon index. - */ +// Fortran-style assignment for colon index. + void tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type mci) @@ -553,11 +546,10 @@ } } -/* - * Assignments to vectors. Hand off to other functions once we know - * what kind of index we have. For a colon, it is the same as - * assignment to a matrix indexed by two colons. - */ +// Assignments to vectors. Hand off to other functions once we know +// what kind of index we have. For a colon, it is the same as +// assignment to a matrix indexed by two colons. + void tree_constant_rep::vector_assignment (tree_constant& rhs, tree_constant& i_arg) { @@ -636,9 +628,8 @@ } } -/* - * Check whether an indexed assignment to a vector is valid. - */ +// Check whether an indexed assignment to a vector is valid. + void tree_constant_rep::check_vector_assign (int rhs_nr, int rhs_nc, int ilen, const char *rm) @@ -674,9 +665,8 @@ panic_impossible (); } -/* - * Assignment to a vector with an integer index. - */ +// Assignment to a vector with an integer index. + void tree_constant_rep::do_vector_assign (tree_constant& rhs, int i) { @@ -732,9 +722,8 @@ } } -/* - * Assignment to a vector with a vector index. - */ +// Assignment to a vector with a vector index. + void tree_constant_rep::do_vector_assign (tree_constant& rhs, idx_vector& iv) { @@ -837,9 +826,8 @@ panic_impossible (); } -/* - * Assignment to a vector with a range index. - */ +// Assignment to a vector with a range index. + void tree_constant_rep::do_vector_assign (tree_constant& rhs, Range& ri) { @@ -935,20 +923,19 @@ panic_impossible (); } -/* - * Matrix assignment indexed by two values. This function determines - * the type of the first arugment, checks as much as possible, and - * then calls one of a set of functions to handle the specific cases: - * - * M (integer, arg2) = RHS (MA1) - * M (vector, arg2) = RHS (MA2) - * M (range, arg2) = RHS (MA3) - * M (colon, arg2) = RHS (MA4) - * - * Each of those functions determines the type of the second argument - * and calls another function to handle the real work of doing the - * assignment. - */ +// Matrix assignment indexed by two values. This function determines +// the type of the first arugment, checks as much as possible, and +// then calls one of a set of functions to handle the specific cases: +// +// M (integer, arg2) = RHS (MA1) +// M (vector, arg2) = RHS (MA2) +// M (range, arg2) = RHS (MA3) +// M (colon, arg2) = RHS (MA4) +// +// Each of those functions determines the type of the second argument +// and calls another function to handle the real work of doing the +// assignment. + void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant& i_arg, @@ -1012,7 +999,7 @@ } } -/* MA1 */ +// -*- MA1 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, tree_constant& j_arg) @@ -1150,7 +1137,7 @@ } } -/* MA2 */ +// -*- MA2 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, tree_constant& j_arg) @@ -1282,7 +1269,7 @@ } } -/* MA3 */ +// -*- MA3 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, tree_constant& j_arg) @@ -1419,7 +1406,7 @@ } } -/* MA4 */ +// -*- MA4 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type i, @@ -1584,25 +1571,23 @@ } } -/* - * Functions that actually handle assignment to a matrix using two - * index values. - * - * idx2 - * +---+---+----+----+ - * idx1 | i | v | r | c | - * ---------+---+---+----+----+ - * integer | 1 | 5 | 9 | 13 | - * ---------+---+---+----+----+ - * vector | 2 | 6 | 10 | 14 | - * ---------+---+---+----+----+ - * range | 3 | 7 | 11 | 15 | - * ---------+---+---+----+----+ - * colon | 4 | 8 | 12 | 16 | - * ---------+---+---+----+----+ - */ +// Functions that actually handle assignment to a matrix using two +// index values. +// +// idx2 +// +---+---+----+----+ +// idx1 | i | v | r | c | +// ---------+---+---+----+----+ +// integer | 1 | 5 | 9 | 13 | +// ---------+---+---+----+----+ +// vector | 2 | 6 | 10 | 14 | +// ---------+---+---+----+----+ +// range | 3 | 7 | 11 | 15 | +// ---------+---+---+----+----+ +// colon | 4 | 8 | 12 | 16 | +// ---------+---+---+----+----+ -/* 1 */ +// -*- 1 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, int j) { @@ -1610,7 +1595,7 @@ rhs.is_real_type ()); } -/* 2 */ +// -*- 2 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, idx_vector& jv) @@ -1622,7 +1607,7 @@ rhs_cm.elem (0, j), rhs.is_real_type ()); } -/* 3 */ +// -*- 3 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, Range& rj) { @@ -1640,7 +1625,7 @@ } } -/* 4 */ +// -*- 4 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, tree_constant_rep::constant_type mcj) @@ -1670,7 +1655,7 @@ panic_impossible (); } -/* 5 */ +// -*- 5 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, int j) @@ -1685,7 +1670,7 @@ } } -/* 6 */ +// -*- 6 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, idx_vector& jv) @@ -1704,7 +1689,7 @@ } } -/* 7 */ +// -*- 7 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, Range& rj) @@ -1727,7 +1712,7 @@ } } -/* 8 */ +// -*- 8 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, tree_constant_rep::constant_type mcj) @@ -1756,7 +1741,7 @@ } } -/* 9 */ +// -*- 9 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, int j) { @@ -1774,7 +1759,7 @@ } } -/* 10 */ +// -*- 10 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, idx_vector& jv) @@ -1797,7 +1782,7 @@ } } -/* 11 */ +// -*- 11 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, Range& rj) @@ -1823,7 +1808,7 @@ } } -/* 12 */ +// -*- 12 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, tree_constant_rep::constant_type mcj) @@ -1854,7 +1839,7 @@ } } -/* 13 */ +// -*- 13 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type mci, @@ -1885,7 +1870,7 @@ panic_impossible (); } -/* 14 */ +// -*- 14 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type mci, @@ -1915,7 +1900,7 @@ } } -/* 15 */ +// -*- 15 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type mci, @@ -1949,7 +1934,7 @@ } } -/* 16 */ +// -*- 16 -*- void tree_constant_rep::do_matrix_assignment (tree_constant& rhs, tree_constant_rep::constant_type mci, @@ -2011,12 +1996,11 @@ } } -/* - * Functions for deleting rows or columns of a matrix. These are used - * to handle statements like - * - * M (i, j) = [] - */ +// Functions for deleting rows or columns of a matrix. These are used +// to handle statements like +// +// M (i, j) = [] + void tree_constant_rep::delete_row (int idx) {
--- a/src/tc-rep.cc +++ b/src/tc-rep.cc @@ -49,32 +49,6 @@ #include "tc-inlines.h" -// And still some more handy helper functions. - -static int -any_element_less_than (const Matrix& a, double val) -{ - int nr = a.rows (); - int nc = a.columns (); - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - if (a.elem (i, j) < val) - return 1; - return 0; -} - -static int -any_element_greater_than (const Matrix& a, double val) -{ - int nr = a.rows (); - int nc = a.columns (); - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - if (a.elem (i, j) > val) - return 1; - return 0; -} - static int any_element_is_complex (const ComplexMatrix& a) { @@ -1190,23 +1164,34 @@ case complex_matrix_constant: case matrix_constant: { - ColumnVector v = vector_value (); - int len = v.length (); - if (len == 0) - ::error ("can only convert vectors and scalars to strings"); + if (rows () == 0 && columns () == 0) + { + char s = '\0'; + retval = tree_constant (&s); + } else { - char *s = new char [len+1]; - s[len] = '\0'; - for (int i = 0; i < len; i++) + ColumnVector v = vector_value (); + int len = v.length (); + if (len == 0) + { + char s = '\0'; + retval = tree_constant (&s); + } + else { - double d = v.elem (i); - int ival = NINT (d); + char *s = new char [len+1]; + s[len] = '\0'; + for (int i = 0; i < len; i++) + { + double d = v.elem (i); + int ival = NINT (d); // Warn about out of range conversions? - s[i] = (char) ival; + s[i] = (char) ival; + } + retval = tree_constant (s); + delete [] s; } - retval = tree_constant (s); - delete [] s; } } break; @@ -2124,394 +2109,6 @@ return ans; } -static tree_constant -make_diag (const Matrix& v, int k) -{ - int nr = v.rows (); - int nc = v.columns (); - assert (nc == 1 || nr == 1); - - tree_constant retval; - - int roff = 0; - int coff = 0; - if (k > 0) - { - roff = 0; - coff = k; - } - else if (k < 0) - { - roff = -k; - coff = 0; - } - - if (nr == 1) - { - int n = nc + ABS (k); - Matrix m (n, n, 0.0); - for (int i = 0; i < nc; i++) - m.elem (i+roff, i+coff) = v.elem (0, i); - retval = tree_constant (m); - } - else - { - int n = nr + ABS (k); - Matrix m (n, n, 0.0); - for (int i = 0; i < nr; i++) - m.elem (i+roff, i+coff) = v.elem (i, 0); - retval = tree_constant (m); - } - - return retval; -} - -static tree_constant -make_diag (const ComplexMatrix& v, int k) -{ - int nr = v.rows (); - int nc = v.columns (); - assert (nc == 1 || nr == 1); - - tree_constant retval; - - int roff = 0; - int coff = 0; - if (k > 0) - { - roff = 0; - coff = k; - } - else if (k < 0) - { - roff = -k; - coff = 0; - } - - if (nr == 1) - { - int n = nc + ABS (k); - ComplexMatrix m (n, n, 0.0); - for (int i = 0; i < nc; i++) - m.elem (i+roff, i+coff) = v.elem (0, i); - retval = tree_constant (m); - } - else - { - int n = nr + ABS (k); - ComplexMatrix m (n, n, 0.0); - for (int i = 0; i < nr; i++) - m.elem (i+roff, i+coff) = v.elem (i, 0); - retval = tree_constant (m); - } - - return retval; -} - -tree_constant -TC_REP::diag (void) const -{ - if (type_tag == string_constant || type_tag == range_constant) - { - tree_constant tmp = make_numeric (); - return tmp.diag (); - } - - tree_constant retval; - - switch (type_tag) - { - case scalar_constant: - retval = tree_constant (scalar); - break; - - case matrix_constant: - { - int nr = rows (); - int nc = columns (); - if (nr == 0 || nc == 0) - { - Matrix mtmp; - retval = tree_constant (mtmp); - } - else if (nr == 1 || nc == 1) - retval = make_diag (matrix_value (), 0); - else - { - ColumnVector v = matrix->diag (); - if (v.capacity () > 0) - retval = tree_constant (v); - } - } - break; - - case complex_scalar_constant: - retval = tree_constant (*complex_scalar); - break; - - case complex_matrix_constant: - { - int nr = rows (); - int nc = columns (); - if (nr == 0 || nc == 0) - { - Matrix mtmp; - retval = tree_constant (mtmp); - } - else if (nr == 1 || nc == 1) - retval = make_diag (complex_matrix_value (), 0); - else - { - ComplexColumnVector v = complex_matrix->diag (); - if (v.capacity () > 0) - retval = tree_constant (v); - } - } - break; - - case string_constant: - case range_constant: - case magic_colon: - default: - panic_impossible (); - break; - } - - return retval; -} - -tree_constant -TC_REP::diag (const tree_constant& a) const -{ - if (type_tag == string_constant || type_tag == range_constant) - { - tree_constant tmp = make_numeric (); - return tmp.diag (a); - } - - tree_constant tmp_a = a.make_numeric (); - - TC_REP::constant_type a_type = tmp_a.const_type (); - - tree_constant retval; - - switch (type_tag) - { - case scalar_constant: - if (a_type == scalar_constant) - { - int k = NINT (tmp_a.double_value ()); - int n = ABS (k) + 1; - if (k == 0) - retval = tree_constant (scalar); - else if (k > 0) - { - Matrix m (n, n, 0.0); - m.elem (0, k) = scalar; - retval = tree_constant (m); - } - else if (k < 0) - { - Matrix m (n, n, 0.0); - m.elem (-k, 0) = scalar; - retval = tree_constant (m); - } - } - break; - - case matrix_constant: - if (a_type == scalar_constant) - { - int k = NINT (tmp_a.double_value ()); - int nr = rows (); - int nc = columns (); - if (nr == 0 || nc == 0) - { - Matrix mtmp; - retval = tree_constant (mtmp); - } - else if (nr == 1 || nc == 1) - retval = make_diag (matrix_value (), k); - else - { - ColumnVector d = matrix->diag (k); - retval = tree_constant (d); - } - } - else - ::error ("diag: invalid second argument"); - - break; - - case complex_scalar_constant: - if (a_type == scalar_constant) - { - int k = NINT (tmp_a.double_value ()); - int n = ABS (k) + 1; - if (k == 0) - retval = tree_constant (*complex_scalar); - else if (k > 0) - { - ComplexMatrix m (n, n, 0.0); - m.elem (0, k) = *complex_scalar; - retval = tree_constant (m); - } - else if (k < 0) - { - ComplexMatrix m (n, n, 0.0); - m.elem (-k, 0) = *complex_scalar; - retval = tree_constant (m); - } - } - break; - - case complex_matrix_constant: - if (a_type == scalar_constant) - { - int k = NINT (tmp_a.double_value ()); - int nr = rows (); - int nc = columns (); - if (nr == 0 || nc == 0) - { - Matrix mtmp; - retval = tree_constant (mtmp); - } - else if (nr == 1 || nc == 1) - retval = make_diag (complex_matrix_value (), k); - else - { - ComplexColumnVector d = complex_matrix->diag (k); - retval = tree_constant (d); - } - } - else - ::error ("diag: invalid second argument"); - - break; - - case string_constant: - case range_constant: - case magic_colon: - default: - panic_impossible (); - break; - } - - return retval; -} - -// XXX FIXME XXX -- this can probably be rewritten efficiently as a -// nonmember function... - -tree_constant -TC_REP::mapper (Mapper_fcn& m_fcn, int print) const -{ - tree_constant retval; - - if (type_tag == string_constant || type_tag == range_constant) - { - tree_constant tmp = make_numeric (); - return tmp.mapper (m_fcn, print); - } - - switch (type_tag) - { - case scalar_constant: - if (m_fcn.can_return_complex_for_real_arg - && (scalar < m_fcn.lower_limit - || scalar > m_fcn.upper_limit)) - { - if (m_fcn.c_c_mapper) - { - Complex c = m_fcn.c_c_mapper (Complex (scalar)); - retval = tree_constant (c); - } - else - ::error ("%s: unable to handle real arguments", m_fcn.name); - } - else - { - if (m_fcn.d_d_mapper) - { - double d = m_fcn.d_d_mapper (scalar); - retval = tree_constant (d); - } - else - ::error ("%s: unable to handle real arguments", m_fcn.name); - } - break; - - case matrix_constant: - if (m_fcn.can_return_complex_for_real_arg - && (any_element_less_than (*matrix, m_fcn.lower_limit) - || any_element_greater_than (*matrix, m_fcn.upper_limit))) - { - if (m_fcn.c_c_mapper) - { - ComplexMatrix cm = map (m_fcn.c_c_mapper, - ComplexMatrix (*matrix)); - retval = tree_constant (cm); - } - else - ::error ("%s: unable to handle real arguments", m_fcn.name); - } - else - { - if (m_fcn.d_d_mapper) - { - Matrix m = map (m_fcn.d_d_mapper, *matrix); - retval = tree_constant (m); - } - else - ::error ("%s: unable to handle real arguments", m_fcn.name); - } - break; - - case complex_scalar_constant: - if (m_fcn.d_c_mapper) - { - double d; - d = m_fcn.d_c_mapper (*complex_scalar); - retval = tree_constant (d); - } - else if (m_fcn.c_c_mapper) - { - Complex c; - c = m_fcn.c_c_mapper (*complex_scalar); - retval = tree_constant (c); - } - else - ::error ("%s: unable to handle complex arguments", m_fcn.name); - break; - - case complex_matrix_constant: - if (m_fcn.d_c_mapper) - { - Matrix m; - m = map (m_fcn.d_c_mapper, *complex_matrix); - retval = tree_constant (m); - } - else if (m_fcn.c_c_mapper) - { - ComplexMatrix cm; - cm = map (m_fcn.c_c_mapper, *complex_matrix); - retval = tree_constant (cm); - } - else - ::error ("%s: unable to handle complex arguments", m_fcn.name); - break; - - case string_constant: - case range_constant: - case magic_colon: - default: - panic_impossible (); - break; - } - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/tc-rep.h +++ b/src/tc-rep.h @@ -221,15 +221,6 @@ // ------------------------------------------------------------------- -// These may not need to be member functions. - - tree_constant diag (void) const; - tree_constant diag (const tree_constant& a) const; - - tree_constant mapper (Mapper_fcn& m_fcn, int print) const; - -// ------------------------------------------------------------------- - // We want to eliminate this. constant_type const_type (void) const { return type_tag; }
--- a/src/xdiv.cc +++ b/src/xdiv.cc @@ -72,18 +72,16 @@ return 1; } -/* - * Right division functions. - * - * op2 / op1: m cm - * +-- +---+----+ - * matrix | 1 | 3 | - * +---+----+ - * complex_matrix | 2 | 4 | - * +---+----+ - */ +// Right division functions. +// +// op2 / op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ -/* 1 */ +// -*- 1 -*- tree_constant xdiv (const Matrix& a, const Matrix& b) { @@ -108,7 +106,7 @@ return tree_constant (result.transpose ()); } -/* 2 */ +// -*- 2 -*- tree_constant xdiv (const Matrix& a, const ComplexMatrix& b) { @@ -133,7 +131,7 @@ return tree_constant (result.hermitian ()); } -/* 3 */ +// -*- 3 -*- tree_constant xdiv (const ComplexMatrix& a, const Matrix& b) { @@ -158,7 +156,7 @@ return tree_constant (result.hermitian ()); } -/* 4 */ +// -*- 4 -*- tree_constant xdiv (const ComplexMatrix& a, const ComplexMatrix& b) { @@ -183,16 +181,14 @@ return tree_constant (result.hermitian ()); } -/* - * Funny element by element division operations. - * - * op2 \ op1: s cs - * +-- +---+----+ - * matrix | 1 | 3 | - * +---+----+ - * complex_matrix | 2 | 4 | - * +---+----+ - */ +// Funny element by element division operations. +// +// op2 \ op1: s cs +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ tree_constant x_el_div (double a, const Matrix& b) @@ -254,18 +250,16 @@ return tree_constant (result); } -/* - * Left division functions. - * - * op2 \ op1: m cm - * +-- +---+----+ - * matrix | 1 | 3 | - * +---+----+ - * complex_matrix | 2 | 4 | - * +---+----+ - */ +// Left division functions. +// +// op2 \ op1: m cm +// +-- +---+----+ +// matrix | 1 | 3 | +// +---+----+ +// complex_matrix | 2 | 4 | +// +---+----+ -/* 1 */ +// -*- 1 -*- tree_constant xleftdiv (const Matrix& a, const Matrix& b) { @@ -287,7 +281,7 @@ return tree_constant (result); } -/* 2 */ +// -*- 2 -*- tree_constant xleftdiv (const Matrix& a, const ComplexMatrix& b) { @@ -309,7 +303,7 @@ return tree_constant (result); } -/* 3 */ +// -*- 3 -*- tree_constant xleftdiv (const ComplexMatrix& a, const Matrix& b) { @@ -331,7 +325,7 @@ return tree_constant (result); } -/* 4 */ +// -*- 4 -*- tree_constant xleftdiv (const ComplexMatrix& a, const ComplexMatrix& b) {
--- a/src/xpow.cc +++ b/src/xpow.cc @@ -53,23 +53,22 @@ return 0; } -/* - * Safer pow functions. - * - * op2 \ op1: s m cs cm - * +-- +---+---+----+----+ - * scalar | | 1 | 5 | 7 | 11 | - * +---+---+----+----+ - * matrix | 2 | E | 8 | E | - * +---+---+----+----+ - * complex_scalar | 3 | 6 | 9 | 12 | - * +---+---+----+----+ - * complex_matrix | 4 | E | 10 | E | - * +---+---+----+----+ - * - * E -> error, trapped in arith-ops.cc. - */ +// Safer pow functions. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | 1 | 5 | 7 | 11 | +// +---+---+----+----+ +// matrix | 2 | E | 8 | E | +// +---+---+----+----+ +// complex_scalar | 3 | 6 | 9 | 12 | +// +---+---+----+----+ +// complex_matrix | 4 | E | 10 | E | +// +---+---+----+----+ +// +// E -> error, trapped in arith-ops.cc. +// -*- 1 -*- tree_constant xpow (double a, double b) { @@ -82,6 +81,7 @@ return tree_constant (pow (a, b)); } +// -*- 2 -*- tree_constant xpow (double a, const Matrix& b) { @@ -115,6 +115,7 @@ return retval; } +// -*- 3 -*- tree_constant xpow (double a, const Complex& b) { @@ -124,6 +125,7 @@ return tree_constant (result); } +// -*- 4 -*- tree_constant xpow (double a, const ComplexMatrix& b) { @@ -157,6 +159,7 @@ return retval; } +// -*- 5 -*- tree_constant xpow (const Matrix& a, double b) { @@ -217,6 +220,7 @@ return retval; } +// -*- 6 -*- tree_constant xpow (const Matrix& a, const Complex& b) { @@ -243,6 +247,7 @@ return tree_constant (result); } +// -*- 7 -*- tree_constant xpow (const Complex& a, double b) { @@ -251,6 +256,7 @@ return tree_constant (result); } +// -*- 8 -*- tree_constant xpow (const Complex& a, const Matrix& b) { @@ -286,6 +292,7 @@ return retval; } +// -*- 9 -*- tree_constant xpow (const Complex& a, const Complex& b) { @@ -294,6 +301,7 @@ return tree_constant (result); } +// -*- 10 -*- tree_constant xpow (const Complex& a, const ComplexMatrix& b) { @@ -327,6 +335,7 @@ return retval; } +// -*- 11 -*- tree_constant xpow (const ComplexMatrix& a, double b) { @@ -387,6 +396,7 @@ return retval; } +// -*- 12 -*- tree_constant xpow (const ComplexMatrix& a, const Complex& b) { @@ -413,23 +423,22 @@ return tree_constant (result); } -/* - * Safer pow functions that work elementwise for matrices. - * - * op2 \ op1: s m cs cm - * +-- +---+---+----+----+ - * scalar | | * | 3 | * | 9 | - * +---+---+----+----+ - * matrix | 1 | 4 | 7 | 10 | - * +---+---+----+----+ - * complex_scalar | * | 5 | * | 11 | - * +---+---+----+----+ - * complex_matrix | 2 | 6 | 8 | 12 | - * +---+---+----+----+ - * - * * -> not needed. - */ +// Safer pow functions that work elementwise for matrices. +// +// op2 \ op1: s m cs cm +// +-- +---+---+----+----+ +// scalar | | * | 3 | * | 9 | +// +---+---+----+----+ +// matrix | 1 | 4 | 7 | 10 | +// +---+---+----+----+ +// complex_scalar | * | 5 | * | 11 | +// +---+---+----+----+ +// complex_matrix | 2 | 6 | 8 | 12 | +// +---+---+----+----+ +// +// * -> not needed. +// -*- 1 -*- tree_constant elem_xpow (double a, const Matrix& b) { @@ -462,6 +471,7 @@ return retval; } +// -*- 2 -*- tree_constant elem_xpow (double a, const ComplexMatrix& b) { @@ -476,6 +486,7 @@ return tree_constant (result); } +// -*- 3 -*- tree_constant elem_xpow (const Matrix& a, double b) { @@ -509,6 +520,7 @@ return retval; } +// -*- 4 -*- tree_constant elem_xpow (const Matrix& a, const Matrix& b) { @@ -558,6 +570,7 @@ } } +// -*- 5 -*- tree_constant elem_xpow (const Matrix& a, const Complex& b) { @@ -572,6 +585,7 @@ return tree_constant (result); } +// -*- 6 -*- tree_constant elem_xpow (const Matrix& a, const ComplexMatrix& b) { @@ -588,6 +602,7 @@ return tree_constant (result); } +// -*- 7 -*- tree_constant elem_xpow (const Complex& a, const Matrix& b) { @@ -602,6 +617,7 @@ return tree_constant (result); } +// -*- 8 -*- tree_constant elem_xpow (const Complex& a, const ComplexMatrix& b) { @@ -616,6 +632,7 @@ return tree_constant (result); } +// -*- 9 -*- tree_constant elem_xpow (const ComplexMatrix& a, double b) { @@ -630,6 +647,7 @@ return tree_constant (result); } +// -*- 10 -*- tree_constant elem_xpow (const ComplexMatrix& a, const Matrix& b) { @@ -646,6 +664,7 @@ return tree_constant (result); } +// -*- 11 -*- tree_constant elem_xpow (const ComplexMatrix& a, const Complex& b) { @@ -660,6 +679,7 @@ return tree_constant (result); } +// -*- 12 -*- tree_constant elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b) {