Mercurial > octave-nkf
changeset 620:8e4e7e5f307e
[project @ 1994-08-16 04:36:32 by jwe]
| author | jwe |
|---|---|
| date | Tue, 16 Aug 1994 04:36:32 +0000 |
| parents | 8778be2e70e7 |
| children | 9e90d4df19e2 |
| files | src/chol.cc src/colloc.cc src/data.cc src/det.cc src/eig.cc src/expm.cc src/fft.cc src/find.cc src/gripes.cc src/gripes.h src/hess.cc src/ifft.cc src/inv.cc src/lex.l src/load-save.cc src/log.cc src/lu.cc src/minmax.cc src/npsol.cc src/parse.y src/pt-cmd.cc src/pt-const.cc src/pt-const.h src/pt-exp-base.cc src/pt-misc.cc src/qr.cc src/rand.cc src/schur.cc src/sort.cc src/svd.cc src/symtab.cc src/tc-rep.h |
| diffstat | 32 files changed, 1691 insertions(+), 1717 deletions(-) [+] |
line wrap: on
line diff
--- a/src/chol.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/chol.cc Tue Aug 16 04:36:32 1994 +0000 @@ -69,45 +69,41 @@ return retval; } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) + { + Matrix m = tmp.matrix_value (); + int info; + CHOL fact (m, info); + if (info != 0) + error ("chol: matrix not positive definite"); + else + retval = fact.chol_matrix (); + } + else if (tmp.is_complex_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - int info; - CHOL fact (m, info); - if (info != 0) - error ("chol: matrix not positive definite"); - else - retval = fact.chol_matrix (); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - int info; - ComplexCHOL fact (m, info); - if (info != 0) - error ("chol: matrix not positive definite"); - else - retval = fact.chol_matrix (); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - retval = d; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval = c; - } - break; - default: - break; + ComplexMatrix m = tmp.complex_matrix_value (); + int info; + ComplexCHOL fact (m, info); + if (info != 0) + error ("chol: matrix not positive definite"); + else + retval = fact.chol_matrix (); } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + retval = d; + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval = c; + } + else + { + gripe_wrong_type_arg ("chol", tmp); + } + return retval; }
--- a/src/colloc.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/colloc.cc Tue Aug 16 04:36:32 1994 +0000 @@ -46,8 +46,7 @@ return retval; } - if (args(1).const_type () != tree_constant_rep::complex_scalar_constant - && args(1).const_type () != tree_constant_rep::scalar_constant) + if (! args(1).is_scalar_type ()) { error ("colloc: first argument must be a scalar"); return retval;
--- a/src/data.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/data.cc Tue Aug 16 04:36:32 1994 +0000 @@ -133,7 +133,7 @@ else { if (nargin > 0 && args(1).is_defined ()) - retval = args(1).isstr (); + retval = (double) args(1).is_string (); } return retval;
--- a/src/det.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/det.cc Tue Aug 16 04:36:32 1994 +0000 @@ -64,65 +64,61 @@ if (nr == 0 && nc == 0) return 1.0; - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - if (m.rows () == m.columns ()) - { - int info; - double rcond = 0.0; - DET det = m.determinant (info, rcond); - double d = 0.0; - if (info == -1) - warning ("det: matrix singular to machine precision, rcond = %g", - rcond); - else - d = det.value (); + Matrix m = tmp.matrix_value (); + if (m.rows () == m.columns ()) + { + int info; + double rcond = 0.0; + DET det = m.determinant (info, rcond); + double d = 0.0; + if (info == -1) + warning ("det: matrix singular to machine precision, rcond = %g", + rcond); + else + d = det.value (); - retval = d; - } - else - gripe_square_matrix_required ("det"); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - if (m.rows () == m.columns ()) - { - int info; - double rcond = 0.0; - ComplexDET det = m.determinant (info, rcond); - Complex c = 0.0; - if (info == -1) - warning ("det: matrix singular to machine precision, rcond = %g", - rcond); - else - c = det.value (); + retval = d; + } + else + gripe_square_matrix_required ("det"); + } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix m = tmp.complex_matrix_value (); + if (m.rows () == m.columns ()) + { + int info; + double rcond = 0.0; + ComplexDET det = m.determinant (info, rcond); + Complex c = 0.0; + if (info == -1) + warning ("det: matrix singular to machine precision, rcond = %g", + rcond); + else + c = det.value (); - retval = c; - } - else - gripe_square_matrix_required ("det"); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - retval = d; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval = c; - } - break; - default: - break; + retval = c; + } + else + gripe_square_matrix_required ("det"); + } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + retval = d; } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval = c; + } + else + { + gripe_wrong_type_arg ("det", tmp); + } + return retval; }
--- a/src/eig.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/eig.cc Tue Aug 16 04:36:32 1994 +0000 @@ -60,9 +60,8 @@ if (flag < 0) gripe_empty_arg ("eig", 0); Matrix m; - retval.resize (2); + retval(1) = m; retval(0) = m; - retval(1) = m; } else gripe_empty_arg ("eig", 1); @@ -79,34 +78,36 @@ Matrix tmp; ComplexMatrix ctmp; EIG result; - switch (arg.const_type ()) + if (arg.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: tmp.resize (1, 1); tmp.elem (0, 0) = arg.double_value (); result = EIG (tmp); - break; - case tree_constant_rep::matrix_constant: + } + else if (arg.is_real_matrix ()) + { tmp = arg.matrix_value (); result = EIG (tmp); - break; - case tree_constant_rep::complex_scalar_constant: + } + else if (arg.is_complex_scalar ()) + { ctmp.resize (1, 1); ctmp.elem (0, 0) = arg.complex_value (); result = EIG (ctmp); - break; - case tree_constant_rep::complex_matrix_constant: + } + else if (arg.is_complex_matrix ()) + { ctmp = arg.complex_matrix_value (); result = EIG (ctmp); - break; - default: - panic_impossible (); - break; + } + else + { + gripe_wrong_type_arg ("eig", tmp); + return retval; } if (nargout == 0 || nargout == 1) { - retval.resize (1); retval(0) = result.eigenvalues (), 1; } else @@ -115,9 +116,8 @@ ComplexDiagMatrix d (result.eigenvalues ()); - retval.resize (2); + retval(1) = d; retval(0) = result.eigenvectors (); - retval(1) = d; } return retval;
--- a/src/expm.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/expm.cc Tue Aug 16 04:36:32 1994 +0000 @@ -106,210 +106,204 @@ double inf_norm; // norm of preconditioned matrix int minus_one_j; // used in computing pade approx - switch (tmp.const_type ()) + if (tmp.is_complex_matrix ()) { - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - Complex trshift = 0.0; // trace shift value + ComplexMatrix m = tmp.complex_matrix_value (); + Complex trshift = 0.0; // trace shift value // Preconditioning step 1: trace normalization. - for (i = 0; i < n_cols; i++) - trshift += m.elem (i, i); - trshift /= n_cols; - for (i = 0; i < n_cols; i++) - m.elem (i, i) -= trshift; + for (i = 0; i < n_cols; i++) + trshift += m.elem (i, i); + trshift /= n_cols; + for (i = 0; i < n_cols; i++) + m.elem (i, i) -= trshift; // Preconditioning step 2: eigenvalue balancing. - ComplexAEPBALANCE mbal (m, balance_job); - m = mbal.balanced_matrix (); - ComplexMatrix d = mbal.balancing_matrix (); + ComplexAEPBALANCE mbal (m, balance_job); + m = mbal.balanced_matrix (); + ComplexMatrix d = mbal.balancing_matrix (); // Preconditioning step 3: scaling. - ColumnVector work (n_cols); - inf_norm = F77_FCN (zlange) ("I", &n_cols, &n_cols, m. - fortran_vec (), &n_cols, - work.fortran_vec ()); + ColumnVector work (n_cols); + inf_norm = F77_FCN (zlange) ("I", &n_cols, &n_cols, m. + fortran_vec (), &n_cols, + work.fortran_vec ()); - sqpow = (int) (1.0 + log (inf_norm) / log (2.0)); + sqpow = (int) (1.0 + log (inf_norm) / log (2.0)); // Check whether we need to square at all. - if (sqpow < 0) - sqpow = 0; - else - { - for (inf_norm = 1.0, i = 0; i < sqpow; i++) - inf_norm *= 2.0; + if (sqpow < 0) + sqpow = 0; + else + { + for (inf_norm = 1.0, i = 0; i < sqpow; i++) + inf_norm *= 2.0; - m = m / inf_norm; - } + m = m / inf_norm; + } // npp, dpp: pade' approx polynomial matrices. - ComplexMatrix npp (n_cols, n_cols, 0.0); - ComplexMatrix dpp = npp; + ComplexMatrix npp (n_cols, n_cols, 0.0); + ComplexMatrix dpp = npp; // Now powers a^8 ... a^1. - minus_one_j = -1; - for (j = 7; j >= 0; j--) - { - npp = m * npp + m * padec[j]; - dpp = m * dpp + m * (minus_one_j * padec[j]); - minus_one_j *= -1; - } + minus_one_j = -1; + for (j = 7; j >= 0; j--) + { + npp = m * npp + m * padec[j]; + dpp = m * dpp + m * (minus_one_j * padec[j]); + minus_one_j *= -1; + } // Zero power. - dpp = -dpp; - for (j = 0; j < n_cols; j++) - { - npp.elem (j, j) += 1.0; - dpp.elem (j, j) += 1.0; - } + dpp = -dpp; + for (j = 0; j < n_cols; j++) + { + npp.elem (j, j) += 1.0; + dpp.elem (j, j) += 1.0; + } // Compute pade approximation = inverse (dpp) * npp. - ComplexMatrix result = dpp.solve (npp); + ComplexMatrix result = dpp.solve (npp); // Reverse preconditioning step 3: repeated squaring. - while (sqpow) - { - result = result * result; - sqpow--; - } + while (sqpow) + { + result = result * result; + sqpow--; + } // reverse preconditioning step 2: inverse balancing XXX FIXME XXX: // should probably do this with lapack calls instead of a complete // matrix inversion. - result = result.transpose (); - d = d.transpose (); - result = result * d; - result = d.solve (result); - result = result.transpose (); + result = result.transpose (); + d = d.transpose (); + result = result * d; + result = d.solve (result); + result = result.transpose (); // Reverse preconditioning step 1: fix trace normalization. - result = result * exp (trshift); + result = result * exp (trshift); - retval = result; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval = exp (c); - } - break; - case tree_constant_rep::matrix_constant: - { + retval = result; + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval = exp (c); + } + else if (tmp.is_real_matrix ()) + { // Compute the exponential. - Matrix m = tmp.matrix_value (); + Matrix m = tmp.matrix_value (); - double trshift = 0; // trace shift value + double trshift = 0; // trace shift value // Preconditioning step 1: trace normalization. - for (i = 0; i < n_cols; i++) - trshift += m.elem (i, i); - trshift /= n_cols; - for (i = 0; i < n_cols; i++) - m.elem (i, i) -= trshift; + for (i = 0; i < n_cols; i++) + trshift += m.elem (i, i); + trshift /= n_cols; + for (i = 0; i < n_cols; i++) + m.elem (i, i) -= trshift; // Preconditioning step 2: balancing. - AEPBALANCE mbal (m, balance_job); - m = mbal.balanced_matrix (); - Matrix d = mbal.balancing_matrix (); + AEPBALANCE mbal (m, balance_job); + m = mbal.balanced_matrix (); + Matrix d = mbal.balancing_matrix (); // Preconditioning step 3: scaling. - ColumnVector work(n_cols); - inf_norm = F77_FCN (dlange) ("I", &n_cols, &n_cols, - m.fortran_vec (), &n_cols, - work.fortran_vec ()); + ColumnVector work(n_cols); + inf_norm = F77_FCN (dlange) ("I", &n_cols, &n_cols, + m.fortran_vec (), &n_cols, + work.fortran_vec ()); - sqpow = (int) (1.0 + log (inf_norm) / log (2.0)); + sqpow = (int) (1.0 + log (inf_norm) / log (2.0)); // Check whether we need to square at all. - if (sqpow < 0) - sqpow = 0; - else - { - for (inf_norm = 1.0, i = 0; i < sqpow; i++) - inf_norm *= 2.0; + if (sqpow < 0) + sqpow = 0; + else + { + for (inf_norm = 1.0, i = 0; i < sqpow; i++) + inf_norm *= 2.0; - m = m / inf_norm; - } + m = m / inf_norm; + } // npp, dpp: pade' approx polynomial matrices. - Matrix npp (n_cols, n_cols, 0.0); - Matrix dpp = npp; + Matrix npp (n_cols, n_cols, 0.0); + Matrix dpp = npp; // now powers a^8 ... a^1. - minus_one_j = -1; - for (j = 7; j >= 0; j--) - { - npp = m * npp + m * padec[j]; - dpp = m * dpp + m * (minus_one_j * padec[j]); - minus_one_j *= -1; - } + minus_one_j = -1; + for (j = 7; j >= 0; j--) + { + npp = m * npp + m * padec[j]; + dpp = m * dpp + m * (minus_one_j * padec[j]); + minus_one_j *= -1; + } // Zero power. - dpp = -dpp; - for(j = 0; j < n_cols; j++) - { - npp.elem (j, j) += 1.0; - dpp.elem (j, j) += 1.0; - } + dpp = -dpp; + for(j = 0; j < n_cols; j++) + { + npp.elem (j, j) += 1.0; + dpp.elem (j, j) += 1.0; + } // Compute pade approximation = inverse (dpp) * npp. - Matrix result = dpp.solve (npp); + Matrix result = dpp.solve (npp); // Reverse preconditioning step 3: repeated squaring. - while(sqpow) - { - result = result * result; - sqpow--; - } + while (sqpow) + { + result = result * result; + sqpow--; + } // Reverse preconditioning step 2: inverse balancing. - result = result.transpose(); - d = d.transpose (); - result = result * d; - result = d.solve (result); - result = result.transpose (); + result = result.transpose(); + d = d.transpose (); + result = result * d; + result = d.solve (result); + result = result.transpose (); // Reverse preconditioning step 1: fix trace normalization. - result = result * exp (trshift); + result = result * exp (trshift); - retval = result; - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - retval = exp (d); - } - break; - default: - panic_impossible(); - break; + retval = result; + } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + retval = exp (d); + } + else + { + gripe_wrong_type_arg ("expm", tmp); } } return retval;
--- a/src/fft.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/fft.cc Tue Aug 16 04:36:32 1994 +0000 @@ -66,30 +66,27 @@ return retval; } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) + { + Matrix m = tmp.matrix_value (); + ComplexMatrix mfft = m.fourier (); + retval = mfft; + } + else if (tmp.is_complex_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - ComplexMatrix mfft = m.fourier (); - retval = mfft; - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - ComplexMatrix mfft = m.fourier (); - retval = mfft; - } - break; - case tree_constant_rep::scalar_constant: - case tree_constant_rep::complex_scalar_constant: + ComplexMatrix m = tmp.complex_matrix_value (); + ComplexMatrix mfft = m.fourier (); + retval = mfft; + } + else if (tmp.is_scalar_type ()) + { error ("fft: invalid scalar argument"); - break; - default: - panic_impossible (); - break; } + else + { + gripe_wrong_type_arg ("fft", tmp); + } + return retval; }
--- a/src/find.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/find.cc Tue Aug 16 04:36:32 1994 +0000 @@ -169,49 +169,45 @@ tree_constant tmp = args(1).make_numeric (); - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) + { + Matrix m = tmp.matrix_value (); + return find_nonzero_elem_idx (m, nargout); + } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + if (d != 0.0) + { + retval(0) = 1.0; + if (nargout > 1) + retval(1) = 1.0; + if (nargout > 2) + retval(2) = d; + } + } + else if (tmp.is_complex_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - return find_nonzero_elem_idx (m, nargout); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d != 0.0) - { - retval(0) = 1.0; - if (nargout > 1) - retval(1) = 1.0; - if (nargout > 2) - retval(2) = d; - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - return find_nonzero_elem_idx (m, nargout); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - if (c != 0.0) - { - retval(0) = 1.0; - if (nargout > 1) - retval(1) = 1.0; - if (nargout > 2) - retval(2) = c; - } - } - break; - default: - break; + ComplexMatrix m = tmp.complex_matrix_value (); + return find_nonzero_elem_idx (m, nargout); } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + if (c != 0.0) + { + retval(0) = 1.0; + if (nargout > 1) + retval(1) = 1.0; + if (nargout > 2) + retval(2) = c; + } + } + else + { + gripe_wrong_type_arg ("find", tmp); + } + return retval; }
--- a/src/gripes.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/gripes.cc Tue Aug 16 04:36:32 1994 +0000 @@ -1,7 +1,7 @@ // gripes.cc -*- C++ -*- /* -Copyright (C) 1992, 1993 John W. Eaton +Copyright (C) 1992, 1993, 1994 John W. Eaton This file is part of Octave.
--- a/src/gripes.h Mon Aug 15 04:54:33 1994 +0000 +++ b/src/gripes.h Tue Aug 16 04:36:32 1994 +0000 @@ -24,6 +24,8 @@ #if !defined (octave_gripes_h) #define octave_gripes_h 1 +class tree_constant; + extern void gripe_string_invalid (void); extern void gripe_range_invalid (void); extern void gripe_nonconformant (void);
--- a/src/hess.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/hess.cc Tue Aug 16 04:36:32 1994 +0000 @@ -80,82 +80,76 @@ Matrix tmp; ComplexMatrix ctmp; - switch (arg.const_type ()) + if (arg.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - tmp = arg.matrix_value (); + tmp = arg.matrix_value (); - HESS result (tmp); + HESS result (tmp); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = result.hess_matrix (); - } - else - { - retval.resize (2); - retval(0) = result.unitary_hess_matrix (); - retval(1) = result.hess_matrix (); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ctmp = arg.complex_matrix_value (); - - ComplexHESS result (ctmp); + if (nargout == 0 || nargout == 1) + { + retval.resize (1); + retval(0) = result.hess_matrix (); + } + else + { + retval.resize (2); + retval(0) = result.unitary_hess_matrix (); + retval(1) = result.hess_matrix (); + } + } + else if (arg.is_complex_matrix ()) + { + ctmp = arg.complex_matrix_value (); + ComplexHESS result (ctmp); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = result.hess_matrix (); - } - else - { - retval.resize (2); - retval(0) = result.unitary_hess_matrix (); - retval(1) = result.hess_matrix (); - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = arg.double_value (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = d; - } - else - { - retval.resize (2); - retval(0) = 1; - retval(1) = d; - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = arg.complex_value (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = c; - } - else - { - retval.resize (2); - retval(0) = 1; - retval(1) = c; - } - } - break; - default: - panic_impossible (); - break; + if (nargout == 0 || nargout == 1) + { + retval.resize (1); + retval(0) = result.hess_matrix (); + } + else + { + retval.resize (2); + retval(0) = result.unitary_hess_matrix (); + retval(1) = result.hess_matrix (); + } } + else if (arg.is_real_scalar ()) + { + double d = arg.double_value (); + if (nargout == 0 || nargout == 1) + { + retval.resize (1); + retval(0) = d; + } + else + { + retval.resize (2); + retval(0) = 1; + retval(1) = d; + } + } + else if (arg.is_complex_scalar ()) + { + Complex c = arg.complex_value (); + if (nargout == 0 || nargout == 1) + { + retval.resize (1); + retval(0) = c; + } + else + { + retval.resize (2); + retval(0) = 1; + retval(1) = c; + } + } + else + { + gripe_wrong_type_arg ("hess", arg); + } + return retval; }
--- a/src/ifft.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/ifft.cc Tue Aug 16 04:36:32 1994 +0000 @@ -66,30 +66,27 @@ return retval; } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) + { + Matrix m = tmp.matrix_value (); + ComplexMatrix mifft = m.ifourier (); + retval = mifft; + } + else if (tmp.is_complex_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - ComplexMatrix mifft = m.ifourier (); - retval = mifft; - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - ComplexMatrix mifft = m.ifourier (); - retval = mifft; - } - break; - case tree_constant_rep::scalar_constant: - case tree_constant_rep::complex_scalar_constant: + ComplexMatrix m = tmp.complex_matrix_value (); + ComplexMatrix mifft = m.ifourier (); + retval = mifft; + } + else if (tmp.is_scalar_type ()) + { error ("ifft: invalid scalar arguement"); - break; - default: - panic_impossible (); - break; } + else + { + gripe_wrong_type_arg ("ifft", tmp); + } + return retval; }
--- a/src/inv.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/inv.cc Tue Aug 16 04:36:32 1994 +0000 @@ -65,59 +65,55 @@ if (nr == 0 && nc == 0) return mtmp; - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - if (m.rows () == m.columns ()) - { - int info; - double rcond = 0.0; - Matrix minv = m.inverse (info, rcond); - if (info == -1) - warning ("inverse: matrix singular to machine precision,\ + Matrix m = tmp.matrix_value (); + if (m.rows () == m.columns ()) + { + int info; + double rcond = 0.0; + Matrix minv = m.inverse (info, rcond); + if (info == -1) + warning ("inverse: matrix singular to machine precision,\ rcond = %g", rcond); - else - retval = minv; - } - else - gripe_square_matrix_required ("inverse"); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = 1.0 / tmp.double_value (); - retval = d; - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - if (m.rows () == m.columns ()) - { - int info; - double rcond = 0.0; - ComplexMatrix minv = m.inverse (info, rcond); - if (info == -1) - warning ("inverse: matrix singular to machine precision,\ + else + retval = minv; + } + else + gripe_square_matrix_required ("inverse"); + } + else if (tmp.is_real_scalar ()) + { + double d = 1.0 / tmp.double_value (); + retval = d; + } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix m = tmp.complex_matrix_value (); + if (m.rows () == m.columns ()) + { + int info; + double rcond = 0.0; + ComplexMatrix minv = m.inverse (info, rcond); + if (info == -1) + warning ("inverse: matrix singular to machine precision,\ rcond = %g", rcond); - else - retval = minv; - } - else - gripe_square_matrix_required ("inverse"); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = 1.0 / tmp.complex_value (); - retval = c; - } - break; - default: - break; + else + retval = minv; + } + else + gripe_square_matrix_required ("inverse"); } + else if (tmp.is_complex_scalar ()) + { + Complex c = 1.0 / tmp.complex_value (); + retval = c; + } + else + { + gripe_wrong_type_arg ("inv", tmp); + } + return retval; }
--- a/src/lex.l Mon Aug 15 04:54:33 1994 +0000 +++ b/src/lex.l Tue Aug 16 04:36:32 1994 +0000 @@ -414,8 +414,7 @@ TOK_RETURN (']'); } -{D}+{EXPON}?{Im} | -{D}+\.{D}*{EXPON}?{Im} | +{D}+\.?{D}*{EXPON}?{Im} | \.{D}+{EXPON}?{Im} { double value; int nread = sscanf (yytext, "%lf", &value); @@ -434,8 +433,8 @@ return IMAG_NUM; } -{D}+{EXPON}? | -{D}+\.{D}*{EXPON}? | +{D}+/\.[\*/\\^'] | +{D}+\.?{D}*{EXPON}? | \.{D}+{EXPON}? | { double value;
--- a/src/load-save.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/load-save.cc Tue Aug 16 04:36:32 1994 +0000 @@ -1924,6 +1924,8 @@ save_binary_data (ostream& os, const tree_constant& tc, char *name, char *doc, int mark_as_global) { + int fail = 0; + FOUR_BYTE_INT name_len = 0; if (name) name_len = strlen (name); @@ -1943,14 +1945,14 @@ tmp = mark_as_global; os.write (&tmp, 1); - if (tc.is_scalar ()) + if (tc.is_real_scalar ()) { tmp = 1; os.write (&tmp, 1); double tmp = tc.double_value (); os.write (&tmp, 8); } - else if (tc.is_matrix ()) + else if (tc.is_real_matrix ()) { tmp = 2; os.write (&tmp, 1); @@ -2021,13 +2023,26 @@ os.write (&inc, 8); } else - panic_impossible (); + { + gripe_wrong_type_arg ("save", tc); + fail = 1; + } -// Really want to return 1 only if write is successful. - return 1; + return (os && ! fail); } -// Save the data from T along with the corresponding NAME, and global +static void +ascii_save_type (ostream& os, char *type, int mark_as_global) +{ + if (mark_as_global) + os << "# type: global "; + else + os << "# type: "; + + os << type << "\n"; +} + +// Save the data from TC along with the corresponding NAME, and global // flag MARK_AS_GLOBAL on stream OS in the plain text format described // above for load_ascii_data. If NAME is null, the name: line is not // generated. PRECISION specifies the number of decimal digits to print. @@ -2035,94 +2050,69 @@ // XXX FIXME XXX -- should probably write the help string here too. int -save_ascii_data (ostream& os, const tree_constant& t, +save_ascii_data (ostream& os, const tree_constant& tc, char *name, int mark_as_global, int precision) { + int fail = 0; + if (! precision) precision = user_pref.save_precision; if (name) os << "# name: " << name << "\n"; - switch (t.const_type ()) - { - case tree_constant_rep::scalar_constant: - case tree_constant_rep::matrix_constant: - case tree_constant_rep::complex_scalar_constant: - case tree_constant_rep::complex_matrix_constant: - case tree_constant_rep::string_constant: - case tree_constant_rep::range_constant: - if (mark_as_global) - os << "# type: global "; - else - os << "# type: "; - break; - - case tree_constant_rep::magic_colon: - default: - break; - } - long old_precision = os.precision (); os.precision (precision); - switch (t.const_type ()) + if (tc.is_real_scalar ()) + { + ascii_save_type (os, "scalar", mark_as_global); + os << tc.double_value () << "\n"; + } + else if (tc.is_real_matrix ()) + { + ascii_save_type (os, "matrix", mark_as_global); + os << "# rows: " << tc.rows () << "\n" + << "# columns: " << tc.columns () << "\n" + << tc.matrix_value () ; + } + else if (tc.is_complex_scalar ()) + { + ascii_save_type (os, "complex scalar", mark_as_global); + os << tc.complex_value () << "\n"; + } + else if (tc.is_complex_matrix ()) { - case tree_constant_rep::scalar_constant: - os << "scalar\n" - << t.double_value () << "\n"; - break; - - case tree_constant_rep::matrix_constant: - os << "matrix\n" - << "# rows: " << t.rows () << "\n" - << "# columns: " << t.columns () << "\n" - << t.matrix_value () ; - break; - - case tree_constant_rep::complex_scalar_constant: - os << "complex scalar\n" - << t.complex_value () << "\n"; - break; - - case tree_constant_rep::complex_matrix_constant: - os << "complex matrix\n" - << "# rows: " << t.rows () << "\n" - << "# columns: " << t.columns () << "\n" - << t.complex_matrix_value () ; - break; - - case tree_constant_rep::string_constant: - { - char *tmp = t.string_value (); - os << "string\n" - << "# length: " << strlen (tmp) << "\n" - << tmp << "\n"; - } - break; - - case tree_constant_rep::range_constant: - { - Range tmp = t.range_value (); - - os << "range\n" - << "# base, limit, increment\n" - << tmp.base () << " " - << tmp.limit () << " " - << tmp.inc () << "\n"; - } - break; - - case tree_constant_rep::magic_colon: - default: - panic_impossible (); - break; + ascii_save_type (os, "complex matrix", mark_as_global); + os << "# rows: " << tc.rows () << "\n" + << "# columns: " << tc.columns () << "\n" + << tc.complex_matrix_value () ; + } + else if (tc.is_string ()) + { + ascii_save_type (os, "string", mark_as_global); + char *tmp = tc.string_value (); + os << "# length: " << strlen (tmp) << "\n" + << tmp << "\n"; + } + else if (tc.is_string ()) + { + ascii_save_type (os, "range", mark_as_global); + Range tmp = tc.range_value (); + os << "# base, limit, increment\n" + << tmp.base () << " " + << tmp.limit () << " " + << tmp.inc () << "\n"; + } + else + { + gripe_wrong_type_arg ("save", tc); + fail = 1; } os.precision (old_precision); -// Really want to return 1 only if write is successful. - return 1; + return (os && ! fail); } // Save the info from sr on stream os in the format specified by fmt. @@ -2178,11 +2168,16 @@ int i; for (i = 0; i < count; i++) - do_save (os, vars[i], fmt); + { + do_save (os, vars[i], fmt); + + if (error_state) + break; + } delete [] vars; - if (save_builtins) + if (! error_state && save_builtins) { symbol_record **vars = global_sym_tab->glob (count, pattern, symbol_def::BUILTIN_VARIABLE, SYMTAB_ALL_SCOPES); @@ -2190,7 +2185,12 @@ saved += count; for (i = 0; i < count; i++) - do_save (os, vars[i], fmt); + { + do_save (os, vars[i], fmt); + + if (error_state) + break; + } delete [] vars; } @@ -2335,19 +2335,20 @@ // Maybe this should be a static function in tree-plot.cc? -// If T is matrix, save it on stream OS in a format useful for +// If TC is matrix, save it on stream OS in a format useful for // making a 3-dimensional plot with gnuplot. If PARAMETRIC is // nonzero, assume a parametric 3-dimensional plot will be generated. int -save_three_d (ostream& os, const tree_constant& t, int parametric) +save_three_d (ostream& os, const tree_constant& tc, int parametric) { - int nr = t.rows (); - int nc = t.columns (); + int fail = 0; - switch (t.const_type ()) + int nr = tc.rows (); + int nc = tc.columns (); + + if (tc.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: os << "# 3D data...\n" << "# type: matrix\n" << "# total rows: " << nr << "\n" @@ -2359,7 +2360,7 @@ if (extras) warning ("ignoring last %d columns", extras); - Matrix tmp = t.matrix_value (); + Matrix tmp = tc.matrix_value (); for (int i = 0; i < nc-extras; i += 3) { os << tmp.extract (0, i, nr-1, i+2); @@ -2369,7 +2370,7 @@ } else { - Matrix tmp = t.matrix_value (); + Matrix tmp = tc.matrix_value (); for (int i = 0; i < nc; i++) { os << tmp.extract (0, i, nr-1, i); @@ -2377,15 +2378,14 @@ os << "\n"; } } - break; - - default: + } + else + { ::error ("for now, I can only save real matrices in 3D format"); - return 0; - break; + fail = 1; } -// Really want to return 1 only if write is successful. - return 1; + + return (os && ! fail); } /*
--- a/src/log.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/log.cc Tue Aug 16 04:36:32 1994 +0000 @@ -66,91 +66,87 @@ gripe_empty_arg ("logm", 1); } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); + Matrix m = tmp.matrix_value (); + + int nr = m.rows (); + int nc = m.columns (); - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("logm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); + if (nr == 0 || nc == 0 || nr != nc) + gripe_square_matrix_required ("logm"); + else + { + EIG m_eig (m); + ComplexColumnVector lambda (m_eig.eigenvalues ()); + ComplexMatrix Q (m_eig.eigenvectors ()); - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = log (real (elt)); - else - lambda.elem (i) = log (elt); - } + for (int i = 0; i < nr; i++) + { + Complex elt = lambda.elem (i); + if (imag (elt) == 0.0 && real (elt) > 0.0) + lambda.elem (i) = log (real (elt)); + else + lambda.elem (i) = log (elt); + } - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); + ComplexDiagMatrix D (lambda); + ComplexMatrix result = Q * D * Q.inverse (); - retval(0) = result; - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); + retval(0) = result; + } + } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix m = tmp.complex_matrix_value (); - int nr = m.rows (); - int nc = m.columns (); + int nr = m.rows (); + int nc = m.columns (); - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("logm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); + if (nr == 0 || nc == 0 || nr != nc) + gripe_square_matrix_required ("logm"); + else + { + EIG m_eig (m); + ComplexColumnVector lambda (m_eig.eigenvalues ()); + ComplexMatrix Q (m_eig.eigenvectors ()); - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = log (real (elt)); - else - lambda.elem (i) = log (elt); - } + for (int i = 0; i < nr; i++) + { + Complex elt = lambda.elem (i); + if (imag (elt) == 0.0 && real (elt) > 0.0) + lambda.elem (i) = log (real (elt)); + else + lambda.elem (i) = log (elt); + } - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); + ComplexDiagMatrix D (lambda); + ComplexMatrix result = Q * D * Q.inverse (); - retval(0) = result; - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d > 0.0) - retval(0) = log (d); - else - { - Complex dtmp (d); - retval(0) = log (dtmp); - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval(0) = log (c); - } - break; - default: - break; + retval(0) = result; + } } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + if (d > 0.0) + retval(0) = log (d); + else + { + Complex dtmp (d); + retval(0) = log (dtmp); + } + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval(0) = log (c); + } + else + { + gripe_wrong_type_arg ("logm", tmp); + } + return retval; } @@ -184,91 +180,87 @@ gripe_empty_arg ("sqrtm", 1); } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); + Matrix m = tmp.matrix_value (); + + int nr = m.rows (); + int nc = m.columns (); - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("sqrtm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); + if (nr == 0 || nc == 0 || nr != nc) + gripe_square_matrix_required ("sqrtm"); + else + { + EIG m_eig (m); + ComplexColumnVector lambda (m_eig.eigenvalues ()); + ComplexMatrix Q (m_eig.eigenvectors ()); - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = sqrt (real (elt)); - else - lambda.elem (i) = sqrt (elt); - } + for (int i = 0; i < nr; i++) + { + Complex elt = lambda.elem (i); + if (imag (elt) == 0.0 && real (elt) > 0.0) + lambda.elem (i) = sqrt (real (elt)); + else + lambda.elem (i) = sqrt (elt); + } - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); + ComplexDiagMatrix D (lambda); + ComplexMatrix result = Q * D * Q.inverse (); - retval(0) = result; - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); + retval(0) = result; + } + } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix m = tmp.complex_matrix_value (); - int nr = m.rows (); - int nc = m.columns (); + int nr = m.rows (); + int nc = m.columns (); - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("sqrtm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); + if (nr == 0 || nc == 0 || nr != nc) + gripe_square_matrix_required ("sqrtm"); + else + { + EIG m_eig (m); + ComplexColumnVector lambda (m_eig.eigenvalues ()); + ComplexMatrix Q (m_eig.eigenvectors ()); - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = sqrt (real (elt)); - else - lambda.elem (i) = sqrt (elt); - } + for (int i = 0; i < nr; i++) + { + Complex elt = lambda.elem (i); + if (imag (elt) == 0.0 && real (elt) > 0.0) + lambda.elem (i) = sqrt (real (elt)); + else + lambda.elem (i) = sqrt (elt); + } - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); + ComplexDiagMatrix D (lambda); + ComplexMatrix result = Q * D * Q.inverse (); - retval(0) = result; - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d > 0.0) - retval(0) = sqrt (d); - else - { - Complex dtmp (d); - retval(0) = sqrt (dtmp); - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval(0) = log (c); - } - break; - default: - break; + retval(0) = result; + } } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + if (d > 0.0) + retval(0) = sqrt (d); + else + { + Complex dtmp (d); + retval(0) = sqrt (dtmp); + } + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval(0) = log (c); + } + else + { + gripe_wrong_type_arg ("sqrtm", tmp); + } + return retval; }
--- a/src/lu.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/lu.cc Tue Aug 16 04:36:32 1994 +0000 @@ -64,85 +64,83 @@ gripe_empty_arg ("lu", 1); } - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - if (m.rows () == m.columns ()) - { - LU fact (m); - switch (nargout) - { - case 1: - case 2: - { - Matrix P = fact.P (); - Matrix L = P.transpose () * fact.L (); - retval(1) = fact.U (); - retval(0) = L; - } - break; - case 3: - default: - retval(2) = fact.P (); - retval(1) = fact.U (); - retval(0) = fact.L (); - break; - } - } - else - gripe_square_matrix_required ("lu"); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - if (m.rows () == m.columns ()) - { - ComplexLU fact (m); - switch (nargout) + Matrix m = tmp.matrix_value (); + if (m.rows () == m.columns ()) + { + LU fact (m); + switch (nargout) + { + case 0: + case 1: + case 2: { - case 1: - case 2: - { - ComplexMatrix P = fact.P (); - ComplexMatrix L = P.transpose () * fact.L (); - retval(1) = fact.U (); - retval(0) = L; - } - break; - case 3: - default: - retval(2) = fact.P (); + Matrix P = fact.P (); + Matrix L = P.transpose () * fact.L (); retval(1) = fact.U (); - retval(0) = fact.L (); - break; + retval(0) = L; } - } - else - gripe_square_matrix_required ("lu"); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - retval(2) = 1.0; - retval(1) = d; - retval(0) = 1.0; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval(2) = 1.0; - retval(1) = c; - retval(0) = 1.0; - } - break; - default: - break; + break; + case 3: + default: + retval(2) = fact.P (); + retval(1) = fact.U (); + retval(0) = fact.L (); + break; + } + } + else + gripe_square_matrix_required ("lu"); } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix m = tmp.complex_matrix_value (); + if (m.rows () == m.columns ()) + { + ComplexLU fact (m); + switch (nargout) + { + case 0: + case 1: + case 2: + { + ComplexMatrix P = fact.P (); + ComplexMatrix L = P.transpose () * fact.L (); + retval(1) = fact.U (); + retval(0) = L; + } + break; + case 3: + default: + retval(2) = fact.P (); + retval(1) = fact.U (); + retval(0) = fact.L (); + break; + } + } + else + gripe_square_matrix_required ("lu"); + } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + retval(2) = 1.0; + retval(1) = d; + retval(0) = 1.0; + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + retval(2) = 1.0; + retval(1) = c; + retval(0) = 1.0; + } + else + { + gripe_wrong_type_arg ("lu", tmp); + } + return retval; }
--- a/src/minmax.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/minmax.cc Tue Aug 16 04:36:32 1994 +0000 @@ -158,20 +158,14 @@ tree_constant arg1; tree_constant arg2; - tree_constant_rep::constant_type arg1_type = - tree_constant_rep::unknown_constant; - tree_constant_rep::constant_type arg2_type = - tree_constant_rep::unknown_constant; switch (nargin) { case 3: arg2 = args(2).make_numeric (); - arg2_type = arg2.const_type (); // Fall through... case 2: arg1 = args(1).make_numeric (); - arg1_type = arg1.const_type (); break; default: panic_impossible (); @@ -180,88 +174,80 @@ if (nargin == 2 && (nargout == 1 || nargout == 0)) { - retval.resize (1); - switch (arg1_type) + if (arg1.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: retval(0) = arg1.double_value (); - break; - case tree_constant_rep::complex_scalar_constant: + } + else if (arg1.is_complex_scalar ()) + { retval(0) = arg1.complex_value (); - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - retval(0) = m.row_min (); - else - retval(0) = tree_constant (m.column_min (), 0); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - retval(0) = m.row_min (); - else - retval(0) = tree_constant (m.column_min (), 0); - } - break; - default: - panic_impossible (); - break; + } + else if (arg1.is_real_matrix ()) + { + Matrix m = arg1.matrix_value (); + if (m.rows () == 1) + retval(0) = m.row_min (); + else + retval(0) = tree_constant (m.column_min (), 0); + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix m = arg1.complex_matrix_value (); + if (m.rows () == 1) + retval(0) = m.row_min (); + else + retval(0) = tree_constant (m.column_min (), 0); + } + else + { + gripe_wrong_type_arg ("min", arg1); + return retval; } } else if (nargin == 2 && nargout == 2) { - retval.resize (2); - switch (arg1_type) + if (arg1.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: - { - retval(0) = arg1.double_value (); - retval(1) = 1; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = arg1.complex_value (); - retval(1) = 1; - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - { - retval(0) = m.row_min (); - retval(1) = m.row_min_loc (); - } - else - { - retval(0) = tree_constant (m.column_min (), 0); - retval(1) = tree_constant (m.column_min_loc (), 0); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - { - retval(0) = m.row_min (); - retval(1) = m.row_min_loc (); - } - else - { - retval(0) = tree_constant (m.column_min (), 0); - retval(1) = tree_constant (m.column_min_loc (), 0); - } - } - break; - default: - panic_impossible (); - break; + retval(1) = 1; + retval(0) = arg1.double_value (); + } + else if (arg1.is_complex_scalar ()) + { + retval(1) = 1; + retval(0) = arg1.complex_value (); + } + else if (arg1.is_real_matrix ()) + { + Matrix m = arg1.matrix_value (); + if (m.rows () == 1) + { + retval(1) = m.row_min_loc (); + retval(0) = m.row_min (); + } + else + { + retval(1) = tree_constant (m.column_min_loc (), 0); + retval(0) = tree_constant (m.column_min (), 0); + } + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix m = arg1.complex_matrix_value (); + if (m.rows () == 1) + { + retval(1) = m.row_min_loc (); + retval(0) = m.row_min (); + } + else + { + retval(1) = tree_constant (m.column_min_loc (), 0); + retval(0) = tree_constant (m.column_min (), 0); + } + } + else + { + gripe_wrong_type_arg ("min", arg1); + return retval; } } else if (nargin == 3) @@ -269,48 +255,43 @@ if (arg1.rows () == arg2.rows () && arg1.columns () == arg2.columns ()) { - retval.resize (1); - switch (arg1_type) +// XXX FIXME XXX -- I don't think this is quite right. + if (arg1.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: - { - double result; - double a_elem = arg1.double_value (); - double b_elem = arg2.double_value (); - result = MIN (a_elem, b_elem); - retval(0) = result; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex result; - Complex a_elem = arg1.complex_value (); - Complex b_elem = arg2.complex_value (); - if (abs (a_elem) < abs (b_elem)) - result = a_elem; - else - result = b_elem; - retval(0) = result; - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix result; - result = min (arg1.matrix_value (), arg2.matrix_value ()); - retval(0) = result; - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix result; - result = min (arg1.complex_matrix_value (), - arg2.complex_matrix_value ()); - retval(0) = result; - } - break; - default: - panic_impossible (); - break; + double result; + double a_elem = arg1.double_value (); + double b_elem = arg2.double_value (); + result = MIN (a_elem, b_elem); + retval(0) = result; + } + else if (arg1.is_complex_scalar ()) + { + Complex result; + Complex a_elem = arg1.complex_value (); + Complex b_elem = arg2.complex_value (); + if (abs (a_elem) < abs (b_elem)) + result = a_elem; + else + result = b_elem; + retval(0) = result; + } + else if (arg1.is_real_matrix ()) + { + Matrix result; + result = min (arg1.matrix_value (), arg2.matrix_value ()); + retval(0) = result; + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix result; + result = min (arg1.complex_matrix_value (), + arg2.complex_matrix_value ()); + retval(0) = result; + } + else + { + gripe_wrong_type_arg ("min", arg1); + return retval; } } else @@ -337,20 +318,14 @@ tree_constant arg1; tree_constant arg2; - tree_constant_rep::constant_type arg1_type = - tree_constant_rep::unknown_constant; - tree_constant_rep::constant_type arg2_type = - tree_constant_rep::unknown_constant; switch (nargin) { case 3: arg2 = args(2).make_numeric (); - arg2_type = arg2.const_type (); // Fall through... case 2: arg1 = args(1).make_numeric (); - arg1_type = arg1.const_type (); break; default: panic_impossible (); @@ -359,137 +334,124 @@ if (nargin == 2 && (nargout == 1 || nargout == 0)) { - retval.resize (1); - switch (arg1_type) + if (arg1.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: retval(0) = arg1.double_value (); - break; - case tree_constant_rep::complex_scalar_constant: + } + else if (arg1.is_complex_scalar ()) + { retval(0) = arg1.complex_value (); - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - retval(0) = m.row_max (); - else - retval(0) = tree_constant (m.column_max (), 0); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - retval(0) = m.row_max (); - else - retval(0) = tree_constant (m.column_max (), 0); - } - break; - default: - panic_impossible (); - break; + } + else if (arg1.is_real_matrix ()) + { + Matrix m = arg1.matrix_value (); + if (m.rows () == 1) + retval(0) = m.row_max (); + else + retval(0) = tree_constant (m.column_max (), 0); + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix m = arg1.complex_matrix_value (); + if (m.rows () == 1) + retval(0) = m.row_max (); + else + retval(0) = tree_constant (m.column_max (), 0); + } + else + { + gripe_wrong_type_arg ("max", arg1); + return retval; } } else if (nargin == 2 && nargout == 2) { - retval.resize (2); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - { - retval(0) = arg1.double_value (); - retval(1) = 1; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = arg1.complex_value (); - retval(1) = 1; - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - { - retval(0) = m.row_max (); - retval(1) = m.row_max_loc (); - } - else - { - retval(0) = tree_constant (m.column_max (), 0); - retval(1) = tree_constant (m.column_max_loc (), 0); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - { - retval(0) = m.row_max (); - retval(1) = m.row_max_loc (); - } - else - { - retval(0) = tree_constant (m.column_max (), 0); - retval(1) = tree_constant (m.column_max_loc (), 0); - } - } - break; - default: - panic_impossible (); - break; - } + if (arg1.is_real_scalar ()) + { + retval(1) = 1; + retval(0) = arg1.double_value (); + } + else if (arg1.is_complex_scalar ()) + { + retval(1) = 1; + retval(0) = arg1.complex_value (); + } + else if (arg1.is_real_matrix ()) + { + Matrix m = arg1.matrix_value (); + if (m.rows () == 1) + { + retval(1) = m.row_max_loc (); + retval(0) = m.row_max (); + } + else + { + retval(1) = tree_constant (m.column_max_loc (), 0); + retval(0) = tree_constant (m.column_max (), 0); + } + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix m = arg1.complex_matrix_value (); + if (m.rows () == 1) + { + retval(1) = m.row_max_loc (); + retval(0) = m.row_max (); + } + else + { + retval(1) = tree_constant (m.column_max_loc (), 0); + retval(0) = tree_constant (m.column_max (), 0); + } + } + else + { + gripe_wrong_type_arg ("max", arg1); + return retval; + } } else if (nargin == 3) { if (arg1.rows () == arg2.rows () && arg1.columns () == arg2.columns ()) { - retval.resize (1); - switch (arg1_type) +// XXX FIXME XXX -- I don't think this is quite right. + if (arg1.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: - { - double result; - double a_elem = arg1.double_value (); - double b_elem = arg2.double_value (); - result = MAX (a_elem, b_elem); - retval(0) = result; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex result; - Complex a_elem = arg1.complex_value (); - Complex b_elem = arg2.complex_value (); - if (abs (a_elem) > abs (b_elem)) - result = a_elem; - else - result = b_elem; - retval(0) = result; - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix result; - result = max (arg1.matrix_value (), arg2.matrix_value ()); - retval(0) = result; - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix result; - result = max (arg1.complex_matrix_value (), - arg2.complex_matrix_value ()); - retval(0) = result; - } - break; - default: - panic_impossible (); - break; + double result; + double a_elem = arg1.double_value (); + double b_elem = arg2.double_value (); + result = MAX (a_elem, b_elem); + retval(0) = result; + } + else if (arg1.is_complex_scalar ()) + { + Complex result; + Complex a_elem = arg1.complex_value (); + Complex b_elem = arg2.complex_value (); + if (abs (a_elem) > abs (b_elem)) + result = a_elem; + else + result = b_elem; + retval(0) = result; + } + else if (arg1.is_real_matrix ()) + { + Matrix result; + result = max (arg1.matrix_value (), arg2.matrix_value ()); + retval(0) = result; + } + else if (arg1.is_complex_matrix ()) + { + ComplexMatrix result; + result = max (arg1.complex_matrix_value (), + arg2.complex_matrix_value ()); + retval(0) = result; + } + else + { + gripe_wrong_type_arg ("max", arg1); + return retval; } } else
--- a/src/npsol.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/npsol.cc Tue Aug 16 04:36:32 1994 +0000 @@ -95,27 +95,25 @@ } } - switch (objective_value.const_type ()) + if (objective_value.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = objective_value.matrix_value (); - if (m.rows () == 1 && m.columns () == 1) - retval = m.elem (0, 0); - else - { - gripe_user_returned_invalid ("npsol_objective"); - npsol_objective_error = 1; // XXX FIXME XXX - } - } - break; - case tree_constant_rep::scalar_constant: + Matrix m = objective_value.matrix_value (); + if (m.rows () == 1 && m.columns () == 1) + retval = m.elem (0, 0); + else + { + gripe_user_returned_invalid ("npsol_objective"); + npsol_objective_error = 1; // XXX FIXME XXX + } + } + else if (objective_value.is_real_scalar ()) + { retval = objective_value.double_value (); - break; - default: + } + else + { gripe_user_returned_invalid ("npsol_objective"); npsol_objective_error = 1; // XXX FIXME XXX - break; } return retval;
--- a/src/parse.y Mon Aug 15 04:54:33 1994 +0000 +++ b/src/parse.y Tue Aug 16 04:36:32 1994 +0000 @@ -1077,13 +1077,15 @@ arg_list : ':' { tree_constant *colon; - colon = new tree_constant (tree_constant_rep::magic_colon); + tree_constant::magic_colon t; + colon = new tree_constant (t); $$ = new tree_argument_list (colon); } | arg_list ',' ':' { tree_constant *colon; - colon = new tree_constant (tree_constant_rep::magic_colon); + tree_constant::magic_colon t; + colon = new tree_constant (t); $1->append (colon); } | expression
--- a/src/pt-cmd.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/pt-cmd.cc Tue Aug 16 04:36:32 1994 +0000 @@ -159,7 +159,8 @@ warning ("while: empty matrix used in conditional"); else if (flag == 0) { - ::error ("while: empty matrix used in conditional"); + ::error ("empty matrix used in while condition near line\ + %d, column %d", line (), column ()); return; } t1 = tree_constant (0.0); @@ -170,13 +171,16 @@ t1 = t2.all (); } - tree_constant_rep::constant_type t = t1.const_type (); - if (t == tree_constant_rep::scalar_constant) + if (t1.is_real_scalar ()) expr_value = (int) t1.double_value (); - else if (t == tree_constant_rep::complex_scalar_constant) + else if (t1.is_complex_scalar ()) expr_value = t1.complex_value () != 0.0; else - panic_impossible (); + { + ::error ("invalid type used in while condition near line %d,\ + column %d", line (), column ()); + return; + } if (expr_value) { @@ -253,90 +257,84 @@ return; } - tree_constant_rep::constant_type expr_type = tmp_expr.const_type (); - switch (expr_type) + if (tmp_expr.is_scalar_type ()) + { + tree_constant *rhs = new tree_constant (tmp_expr); + int quit = 0; + do_for_loop_once (rhs, quit); + } + else if (tmp_expr.is_matrix_type ()) { - case tree_constant_rep::complex_scalar_constant: - case tree_constant_rep::scalar_constant: - { - tree_constant *rhs = new tree_constant (tmp_expr); - int quit = 0; - do_for_loop_once (rhs, quit); - } - break; - case tree_constant_rep::complex_matrix_constant: - case tree_constant_rep::matrix_constant: - { - Matrix m_tmp; - ComplexMatrix cm_tmp; - int nr; - int steps; - if (expr_type == tree_constant_rep::matrix_constant) - { - m_tmp = tmp_expr.matrix_value (); - nr = m_tmp.rows (); - steps = m_tmp.columns (); - } - else - { - cm_tmp = tmp_expr.complex_matrix_value (); - nr = cm_tmp.rows (); - steps = cm_tmp.columns (); - } + Matrix m_tmp; + ComplexMatrix cm_tmp; + int nr; + int steps; + if (tmp_expr.is_real_matrix ()) + { + m_tmp = tmp_expr.matrix_value (); + nr = m_tmp.rows (); + steps = m_tmp.columns (); + } + else + { + cm_tmp = tmp_expr.complex_matrix_value (); + nr = cm_tmp.rows (); + steps = cm_tmp.columns (); + } - for (int i = 0; i < steps; i++) - { - tree_constant *rhs; + for (int i = 0; i < steps; i++) + { + tree_constant *rhs; - if (nr == 1) - { - if (expr_type == tree_constant_rep::matrix_constant) - rhs = new tree_constant (m_tmp (0, i)); - else - rhs = new tree_constant (cm_tmp (0, i)); - } - else - { - if (expr_type == tree_constant_rep::matrix_constant) - rhs = new tree_constant (m_tmp.extract (0, i, nr-1, i)); - else - rhs = new tree_constant (cm_tmp.extract (0, i, nr-1, i)); - } + if (nr == 1) + { + if (tmp_expr.is_real_matrix ()) + rhs = new tree_constant (m_tmp (0, i)); + else + rhs = new tree_constant (cm_tmp (0, i)); + } + else + { + if (tmp_expr.is_real_matrix ()) + rhs = new tree_constant (m_tmp.extract (0, i, nr-1, i)); + else + rhs = new tree_constant (cm_tmp.extract (0, i, nr-1, i)); + } - int quit = 0; - do_for_loop_once (rhs, quit); - if (quit) - break; - } - } - break; - case tree_constant_rep::string_constant: + int quit = 0; + do_for_loop_once (rhs, quit); + if (quit) + break; + } + } + else if (tmp_expr.is_string ()) + { gripe_string_invalid (); - break; - case tree_constant_rep::range_constant: - { - Range rng = tmp_expr.range_value (); + } + else if (tmp_expr.is_range ()) + { + Range rng = tmp_expr.range_value (); - int steps = rng.nelem (); - double b = rng.base (); - double increment = rng.inc (); + int steps = rng.nelem (); + double b = rng.base (); + double increment = rng.inc (); - for (int i = 0; i < steps; i++) - { - double tmp_val = b + i * increment; + for (int i = 0; i < steps; i++) + { + double tmp_val = b + i * increment; - tree_constant *rhs = new tree_constant (tmp_val); + tree_constant *rhs = new tree_constant (tmp_val); - int quit = 0; - do_for_loop_once (rhs, quit); - if (quit) - break; - } - } - break; - default: - panic_impossible (); - break; + int quit = 0; + do_for_loop_once (rhs, quit); + if (quit) + break; + } + } + else + { + ::error ("invalid type in for loop expression near line %d, column %d", + line (), column ()); } }
--- a/src/pt-const.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/pt-const.cc Tue Aug 16 04:36:32 1994 +0000 @@ -109,6 +109,31 @@ os << ")"; } +void +gripe_wrong_type_arg (const char *name, const tree_constant& tc) +{ + error ("%s: wrong type argument `%s'", name, tc.type_as_string ()); +} + +char * +tree_constant::type_as_string (void) const +{ + if (is_real_scalar ()) + return "real scalar"; + else if (is_real_matrix ()) + return "real matrix"; + else if (is_complex_scalar ()) + return "complex scalar"; + else if (is_complex_matrix ()) + return "complex matrix"; + else if (is_string ()) + return "string"; + else if (is_range ()) + return "range"; + else + return "<unknown type>"; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pt-const.h Mon Aug 15 04:54:33 1994 +0000 +++ b/src/pt-const.h Tue Aug 16 04:36:32 1994 +0000 @@ -37,7 +37,6 @@ #include "tree-base.h" #include "tree-expr.h" -#include "tc-rep.h" #include "oct-obj.h" class idx_vector; @@ -49,31 +48,69 @@ class tree_constant : public tree_fvc { -friend class tree_constant_rep; +private: + +#include "tc-rep.h" + +// The real representation of a constant, declared in tc-rep.h + + tree_constant_rep *rep; public: + + enum magic_colon { magic_colon_t }; + +// Constructors. It is possible to create the following types of +// constants: +// +// constant type constructor arguments +// ------------- --------------------- +// unknown none +// real scalar double +// real matrix Matrix +// DiagMatrix +// RowVector +// ColumnVector +// complex scalar Complex +// complex matrix ComplexMatrix +// ComplexDiagMatrix +// ComplexRowVector +// ComplexColumnVector +// string char* (null terminated) +// range double, double, dobule +// Range +// magic colon tree_constant::magic_colon + tree_constant (void) : tree_fvc () { rep = new tree_constant_rep (); rep->count = 1; } tree_constant (double d) : tree_fvc () { rep = new tree_constant_rep (d); rep->count = 1; } + tree_constant (const Matrix& m) : tree_fvc () { rep = new tree_constant_rep (m); rep->count = 1; } + tree_constant (const DiagMatrix& d) : tree_fvc () { rep = new tree_constant_rep (d); rep->count = 1; } + tree_constant (const RowVector& v, int pcv = -1) : tree_fvc () { rep = new tree_constant_rep (v, pcv); rep->count = 1; } + tree_constant (const ColumnVector& v, int pcv = -1) : tree_fvc () { rep = new tree_constant_rep (v, pcv); rep->count = 1; } tree_constant (const Complex& c) : tree_fvc () { rep = new tree_constant_rep (c); rep->count = 1; } + tree_constant (const ComplexMatrix& m) : tree_fvc () { rep = new tree_constant_rep (m); rep->count = 1; } + tree_constant (const ComplexDiagMatrix& d) : tree_fvc () { rep = new tree_constant_rep (d); rep->count = 1; } + tree_constant (const ComplexRowVector& v, int pcv = -1) : tree_fvc () { rep = new tree_constant_rep (v, pcv); rep->count = 1; } + tree_constant (const ComplexColumnVector& v, int pcv = -1) : tree_fvc () { rep = new tree_constant_rep (v, pcv); rep->count = 1; } @@ -82,15 +119,26 @@ tree_constant (double base, double limit, double inc) : tree_fvc () { rep = new tree_constant_rep (base, limit, inc); rep->count = 1; } + tree_constant (const Range& r) : tree_fvc () { rep = new tree_constant_rep (r); rep->count = 1; } - tree_constant (tree_constant_rep::constant_type t) : tree_fvc () - { rep = new tree_constant_rep (t); rep->count = 1; } + tree_constant (tree_constant::magic_colon t) : tree_fvc () + { + tree_constant_rep::constant_type tmp; + tmp = tree_constant_rep::magic_colon; + rep = new tree_constant_rep (tmp); + rep->count = 1; + } + +// Copy constructor. tree_constant (const tree_constant& a) : tree_fvc () { rep = a.rep; rep->count++; } +// Delete the representation of this constant if the count drops to +// zero. + ~tree_constant (void); #if defined (MDEBUG) @@ -98,6 +146,8 @@ void operator delete (void *p, size_t size); #endif +// Simple assignment. + tree_constant operator = (const tree_constant& a) { if (--rep->count <= 0 && rep != a.rep) @@ -108,80 +158,7 @@ return *this; } - int is_constant (void) const { return 1; } - - int is_scalar_type (void) const { return rep->is_scalar_type (); } - int is_matrix_type (void) const { return rep->is_matrix_type (); } - - int is_real_type (void) const { return rep->is_real_type (); } - int is_complex_type (void) const { return rep->is_complex_type (); } - - int is_numeric_type (void) const { return rep->is_numeric_type (); } - - int is_numeric_or_range_type (void) const - { return rep->is_numeric_or_range_type (); } - - int valid_as_scalar_index (void) const - { return rep->valid_as_scalar_index (); } - -// What type of constant am I? - - int is_unknown (void) const { return rep->is_unknown (); } - int is_scalar (void) const { return rep->is_scalar (); } - int is_matrix (void) const { return rep->is_matrix (); } - int is_complex_scalar (void) const { return rep->is_complex_scalar (); } - int is_complex_matrix (void) const { return rep->is_complex_matrix (); } - int is_string (void) const { return rep->is_string (); } - int is_range (void) const { return rep->is_range (); } - - int is_defined (void) const { return rep->is_defined (); } - int is_undefined (void) const { return rep->is_undefined (); } - - double to_scalar (void) const { return rep->to_scalar (); } - ColumnVector to_vector (void) const { return rep->to_vector (); } - Matrix to_matrix (void) const { return rep->to_matrix (); } - - void stash_original_text (char *s) - { rep->stash_original_text (s); } - - tree_constant_rep::constant_type force_numeric (int force_str_conv = 0) - { return rep->force_numeric (force_str_conv); } - - tree_constant make_numeric (int force_str_conv = 0) const - { - if (is_numeric_type ()) - return *this; - else - return rep->make_numeric (force_str_conv); - } - - tree_constant make_numeric_or_range (void) const - { - if (is_numeric_type () - || rep->type_tag == tree_constant_rep::range_constant) - return *this; - else - return rep->make_numeric (); - } - - tree_constant make_numeric_or_magic (void) const - { - if (is_numeric_type () - || rep->type_tag == tree_constant_rep::magic_colon) - return *this; - else - return rep->make_numeric (); - } - - tree_constant make_numeric_or_range_or_magic (void) const - { - if (is_numeric_type () - || rep->type_tag == tree_constant_rep::magic_colon - || rep->type_tag == tree_constant_rep::range_constant) - return *this; - else - return rep->make_numeric (); - } +// Indexed assignment. tree_constant assign (tree_constant& rhs, const Octave_object& args) { @@ -195,6 +172,80 @@ return *this; } +// Type. It would be nice to eliminate the need for this. + + int is_constant (void) const { return 1; } + +// Size. + + int rows (void) const { return rep->rows (); } + 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(). + + int is_defined (void) const { return rep->is_defined (); } + int is_undefined (void) const { return rep->is_undefined (); } + +// What type is this constant? + + int is_unknown (void) const { return rep->is_unknown (); } + int is_real_scalar (void) const { return rep->is_real_scalar (); } + int is_real_matrix (void) const { return rep->is_real_matrix (); } + int is_complex_scalar (void) const { return rep->is_complex_scalar (); } + int is_complex_matrix (void) const { return rep->is_complex_matrix (); } + int is_string (void) const { return rep->is_string (); } + int is_range (void) const { return rep->is_range (); } + int is_magic_colon (void) const { return rep->is_magic_colon (); } + +// Are any or all of the elements in this constant nonzero? + + tree_constant all (void) const { return rep->all (); } + tree_constant any (void) const { return rep->any (); } + +// Broader classifications. + + int is_scalar_type (void) const { return rep->is_scalar_type (); } + int is_matrix_type (void) const { return rep->is_matrix_type (); } + + int is_real_type (void) const { return rep->is_real_type (); } + int is_complex_type (void) const { return rep->is_complex_type (); } + +// These need better names, since a range really is a numeric type. + + int is_numeric_type (void) const { return rep->is_numeric_type (); } + + int is_numeric_or_range_type (void) const + { return rep->is_numeric_or_range_type (); } + +// Is this constant valid as a scalar index? + + int valid_as_scalar_index (void) const + { return rep->valid_as_scalar_index (); } + +// Does this constant correspond to a truth value? + + int is_true (void) const { return rep->is_true (); } + +// Is at least one of the dimensions of this constant zero? + + int is_empty (void) const + { + return ((! (is_magic_colon () || is_unknown ())) + && (rows () == 0 || columns () == 0)); + } + +// Are the dimensions of this constant zero by zero? + + int is_zero_by_zero (void) const + { + return ((! (is_magic_colon () || is_unknown ())) + && rows () == 0 && columns () == 0); + } + +// Values. + double double_value (void) const { return rep->double_value (); } Matrix matrix_value (void) const { return rep->matrix_value (); } Complex complex_value (void) const { return rep->complex_value (); } @@ -203,50 +254,53 @@ char *string_value (void) const { return rep->string_value (); } Range range_value (void) const { return rep->range_value (); } - int rows (void) const { return rep->rows (); } - int columns (void) const { return rep->columns (); } - - int is_empty (void) const - { - return (rep->type_tag != tree_constant_rep::magic_colon - && rep->type_tag != tree_constant_rep::unknown_constant - && (rows () == 0 || columns () == 0)); - } - - int is_zero_by_zero (void) const - { - return (rep->type_tag != tree_constant_rep::magic_colon - && rep->type_tag != tree_constant_rep::unknown_constant - && rows () == 0 - && columns () == 0); - } - - - tree_constant all (void) const { return rep->all (); } - tree_constant any (void) const { return rep->any (); } - tree_constant isstr (void) const { return rep->isstr (); } +// 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. tree_constant convert_to_str (void) { return rep->convert_to_str (); } void convert_to_row_or_column_vector (void) { rep->convert_to_row_or_column_vector (); } - int is_true (void) const { return rep->is_true (); } +// These need better names, since a range really is a numeric type. + + void force_numeric (int force_str_conv = 0) + { rep->force_numeric (force_str_conv); } - tree_constant cumprod (void) const { return rep->cumprod (); } - tree_constant cumsum (void) const { return rep->cumsum (); } - tree_constant prod (void) const { return rep->prod (); } - tree_constant sum (void) const { return rep->sum (); } - tree_constant sumsq (void) const { return rep->sumsq (); } + tree_constant make_numeric (int force_str_conv = 0) const + { + if (is_numeric_type ()) + return *this; + else + return rep->make_numeric (force_str_conv); + } - tree_constant diag (void) const { return rep->diag (); } - tree_constant diag (const tree_constant& a) const { return rep->diag (a); } + tree_constant make_numeric_or_range (void) const + { + if (is_numeric_type () || is_range ()) + return *this; + else + return rep->make_numeric (); + } - tree_constant_rep::constant_type const_type (void) const - { return rep->const_type (); } + tree_constant make_numeric_or_magic (void) const + { + if (is_numeric_type () || is_magic_colon ()) + return *this; + else + return rep->make_numeric (); + } - tree_constant mapper (Mapper_fcn& m_fcn, int print) const - { return rep->mapper (m_fcn, print); } + tree_constant make_numeric_or_range_or_magic (void) const + { + if (is_numeric_type () || is_range () || is_magic_colon ()) + return *this; + else + return rep->make_numeric (); + } + +// Increment or decrement this constant. void bump_value (tree_expression::type et) { @@ -259,6 +313,9 @@ rep->bump_value (et); } +// Evaluate this constant, possibly converting complex to real, or +// matrix to scalar, etc. + tree_constant eval (int print) { rep->maybe_mutate (); @@ -283,10 +340,55 @@ return retval; } +// Store the original text corresponding to this constant for later +// pretty printing. + + void stash_original_text (char *s) + { rep->stash_original_text (s); } + +// Pretty print this constant. + void print_code (ostream& os); +// Complain about unknown types used as args. + + friend void gripe_wrong_type_arg (const char *name, const tree_constant& tc); + +// ------------------------------------------------------------------- + +// These may not need to be member functions. + + tree_constant cumprod (void) const { return rep->cumprod (); } + tree_constant cumsum (void) const { return rep->cumsum (); } + tree_constant prod (void) const { return rep->prod (); } + tree_constant sum (void) const { return rep->sum (); } + tree_constant sumsq (void) const { return rep->sumsq (); } + + 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 (); } + +// More conversions. These should probably be eliminated. 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. + + double to_scalar (void) const { return rep->to_scalar (); } + ColumnVector to_vector (void) const { return rep->to_vector (); } + Matrix to_matrix (void) const { return rep->to_matrix (); } + +// ------------------------------------------------------------------- + private: - tree_constant_rep *rep; + char *type_as_string (void) const; }; // XXX FIXME XXX -- this is not used very much now. Perhaps it can be
--- a/src/pt-exp-base.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/pt-exp-base.cc Tue Aug 16 04:36:32 1994 +0000 @@ -125,7 +125,7 @@ while (--nargin > 0) { - if (args(nargin).const_type () == tree_constant_rep::magic_colon) + if (args(nargin).is_magic_colon ()) return 1; } return 0; @@ -453,7 +453,6 @@ for (i = 0; i < len; i++) { tree_constant tmp = list[i].elem; - tree_constant_rep::constant_type tmp_type = tmp.const_type (); int nr = list[i].nr; int nc = list[i].nc; @@ -485,74 +484,76 @@ if (found_complex) { - switch (tmp_type) + if (tmp.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: cm (put_row, put_col) = tmp.double_value (); - break; - case tree_constant_rep::string_constant: + } + else if (tmp.is_string ()) + { if (all_strings && str_ptr) { memcpy (str_ptr, tmp.string_value (), nc); str_ptr += nc; - break; } - case tree_constant_rep::range_constant: - tmp_type = tmp.force_numeric (1); - if (tmp_type == tree_constant_rep::scalar_constant) + } + else if (tmp.is_range ()) + { + tmp.force_numeric (1); + if (tmp.is_real_scalar ()) m (put_row, put_col) = tmp.double_value (); - else if (tmp_type == tree_constant_rep::matrix_constant) + else if (tmp.is_real_matrix ()) m.insert (tmp.matrix_value (), put_row, put_col); else panic_impossible (); - break; - case tree_constant_rep::matrix_constant: + } + else if (tmp.is_real_matrix ()) + { cm.insert (tmp.matrix_value (), put_row, put_col); - break; - case tree_constant_rep::complex_scalar_constant: + } + else if (tmp.is_complex_scalar ()) + { cm (put_row, put_col) = tmp.complex_value (); - break; - case tree_constant_rep::complex_matrix_constant: + } + else if (tmp.is_complex_matrix ()) + { cm.insert (tmp.complex_matrix_value (), put_row, put_col); - break; - case tree_constant_rep::magic_colon: - default: + } + else + { panic_impossible (); - break; } } else { - switch (tmp_type) + if (tmp.is_real_scalar ()) { - case tree_constant_rep::scalar_constant: m (put_row, put_col) = tmp.double_value (); - break; - case tree_constant_rep::string_constant: + } + else if (tmp.is_string ()) + { if (all_strings && str_ptr) { memcpy (str_ptr, tmp.string_value (), nc); str_ptr += nc; - break; } - case tree_constant_rep::range_constant: - tmp_type = tmp.force_numeric (1); - if (tmp_type == tree_constant_rep::scalar_constant) + } + else if (tmp.is_range ()) + { + tmp.force_numeric (1); + if (tmp.is_real_scalar ()) m (put_row, put_col) = tmp.double_value (); - else if (tmp_type == tree_constant_rep::matrix_constant) + else if (tmp.is_real_matrix ()) m.insert (tmp.matrix_value (), put_row, put_col); else panic_impossible (); - break; - case tree_constant_rep::matrix_constant: + } + else if (tmp.is_real_matrix ()) + { m.insert (tmp.matrix_value (), put_row, put_col); - break; - case tree_constant_rep::complex_scalar_constant: - case tree_constant_rep::complex_matrix_constant: - case tree_constant_rep::magic_colon: - default: + } + else + { panic_impossible (); - break; } } @@ -1853,8 +1854,7 @@ } tmp = tmp.make_numeric (); - if (tmp.const_type () != tree_constant_rep::scalar_constant - && tmp.const_type () != tree_constant_rep::complex_scalar_constant) + if (! tmp.is_scalar_type ()) { eval_error ("base for colon expression must be a scalar"); return retval; @@ -1871,8 +1871,7 @@ } tmp = tmp.make_numeric (); - if (tmp.const_type () != tree_constant_rep::scalar_constant - && tmp.const_type () != tree_constant_rep::complex_scalar_constant) + if (! tmp.is_scalar_type ()) { eval_error ("limit for colon expression must be a scalar"); return retval; @@ -1892,8 +1891,7 @@ } tmp = tmp.make_numeric (); - if (tmp.const_type () != tree_constant_rep::scalar_constant - && tmp.const_type () != tree_constant_rep::complex_scalar_constant) + if (! tmp.is_scalar_type ()) { eval_error ("increment for colon expression must be a scalar"); return retval;
--- a/src/pt-misc.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/pt-misc.cc Tue Aug 16 04:36:32 1994 +0000 @@ -228,8 +228,7 @@ if (i < nargin) { - if (args(i).is_defined () - && (args(i).const_type () == tree_constant_rep::magic_colon)) + if (args(i).is_defined () && args(i).is_magic_colon ()) { ::error ("invalid use of colon in function argument list"); return; @@ -423,10 +422,10 @@ } int expr_value = 0; - tree_constant_rep::constant_type t = t1.const_type (); - if (t == tree_constant_rep::scalar_constant) + + if (t1.is_real_scalar ()) expr_value = (int) t1.double_value (); - else if (t == tree_constant_rep::complex_scalar_constant) + else if (t1.is_complex_scalar ()) expr_value = t1.complex_value () != 0.0; else panic_impossible ();
--- a/src/qr.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/qr.cc Tue Aug 16 04:36:32 1994 +0000 @@ -88,73 +88,69 @@ QR::type type = nargout == 1 ? QR::raw : (nargin == 3 ? QR::economy : QR::std); - switch (tmp.const_type ()) + if (tmp.is_real_matrix ()) + { + Matrix m = tmp.matrix_value (); + if (nargout < 3) + { + QR fact (m, type); + retval(1) = fact.R (); + retval(0) = fact.Q (); + } + else + { + QRP fact (m, type); + retval(2) = fact.P (); + retval(1) = fact.R (); + retval(0) = fact.Q (); + } + } + else if (tmp.is_complex_matrix ()) { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - if (nargout < 3) - { - QR fact (m, type); - retval(1) = fact.R (); - retval(0) = fact.Q (); - } - else - { - QRP fact (m, type); - retval(2) = fact.P (); - retval(1) = fact.R (); - retval(0) = fact.Q (); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - if (nargout < 3) - { - ComplexQR fact (m, type); - retval(1) = fact.R (); - retval(0) = fact.Q (); - } - else - { - ComplexQRP fact (m, type); - retval(2) = fact.P (); - retval(1) = fact.R (); - retval(0) = fact.Q (); - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (nargout == 1) - retval(0) = d; - else - { - retval(2) = 1.0; - retval(1) = d; - retval(0) = 1.0; - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - if (nargout == 1) - retval(0) = c; - else - { - retval(2) = 1.0; - retval(1) = c; - retval(0) = 1.0; - } - } - break; - default: - break; + ComplexMatrix m = tmp.complex_matrix_value (); + if (nargout < 3) + { + ComplexQR fact (m, type); + retval(1) = fact.R (); + retval(0) = fact.Q (); + } + else + { + ComplexQRP fact (m, type); + retval(2) = fact.P (); + retval(1) = fact.R (); + retval(0) = fact.Q (); + } } + else if (tmp.is_real_scalar ()) + { + double d = tmp.double_value (); + if (nargout == 1) + retval(0) = d; + else + { + retval(2) = 1.0; + retval(1) = d; + retval(0) = 1.0; + } + } + else if (tmp.is_complex_scalar ()) + { + Complex c = tmp.complex_value (); + if (nargout == 1) + retval(0) = c; + else + { + retval(2) = 1.0; + retval(1) = c; + retval(0) = 1.0; + } + } + else + { + gripe_wrong_type_arg ("qr", tmp); + } + return retval; }
--- a/src/rand.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/rand.cc Tue Aug 16 04:36:32 1994 +0000 @@ -153,19 +153,18 @@ } else if (nargin == 2) { - switch (args(1).const_type ()) + tree_constant tmp = args(1); + + if (tmp.is_string ()) { - case tree_constant_rep::string_constant: - char *s_arg = args(1).string_value (); + char *s_arg = tmp.string_value (); if (strcmp (s_arg, "dist") == 0) { - retval.resize (1); char *s = curr_rand_dist (); retval(0) = s; } else if (strcmp (s_arg, "seed") == 0) { - retval.resize (1); double d = curr_rand_seed (); retval(0) = d; } @@ -175,27 +174,30 @@ current_distribution = normal; else error ("rand: unrecognized string argument"); - break; - case tree_constant_rep::scalar_constant: - case tree_constant_rep::complex_scalar_constant: - n = NINT (args(1).double_value ()); + } + else if (tmp.is_scalar_type ()) + { + n = NINT (tmp.double_value ()); m = n; goto gen_matrix; - case tree_constant_rep::range_constant: - { - Range r = args(1).range_value (); - n = 1; - m = NINT (r.nelem ()); - } + } + else if (tmp.is_range ()) + { + Range r = tmp.range_value (); + n = 1; + m = NINT (r.nelem ()); goto gen_matrix; - case tree_constant_rep::matrix_constant: - case tree_constant_rep::complex_matrix_constant: + } + else if (tmp.is_matrix_type ()) + { n = NINT (args(1).rows ()); m = NINT (args(1).columns ()); goto gen_matrix; - default: - panic_impossible (); - break; + } + else + { + gripe_wrong_type_arg ("rand", tmp); + return retval; } } else if (nargin == 3) @@ -220,13 +222,11 @@ if (n == 0 || m == 0) { - retval.resize (1); - Matrix m (0, 0); - retval(0) = m; + Matrix m; + retval.resize (1, m); } else if (n > 0 && m > 0) { - retval.resize (1); Matrix rand_mat (n, m); for (int j = 0; j < m; j++) for (int i = 0; i < n; i++)
--- a/src/schur.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/schur.cc Tue Aug 16 04:36:32 1994 +0000 @@ -105,81 +105,67 @@ Matrix tmp; ComplexMatrix ctmp; - switch (arg.const_type ()) + if (arg.is_real_matrix ()) { - case tree_constant_rep::matrix_constant: - { - tmp = arg.matrix_value (); + tmp = arg.matrix_value (); - SCHUR result (tmp,ord); + SCHUR result (tmp,ord); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = result.schur_matrix (); - } - else - { - retval.resize (2); - retval(0) = result.unitary_matrix (); - retval(1) = result.schur_matrix (); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ctmp = arg.complex_matrix_value (); + if (nargout == 0 || nargout == 1) + { + retval(0) = result.schur_matrix (); + } + else + { + retval(1) = result.schur_matrix (); + retval(0) = result.unitary_matrix (); + } + } + else if (arg.is_complex_matrix ()) + { + ctmp = arg.complex_matrix_value (); - ComplexSCHUR result (ctmp,ord); + ComplexSCHUR result (ctmp,ord); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = result.schur_matrix (); - } - else - { - retval.resize (2); - retval(0) = result.unitary_matrix (); - retval(1) = result.schur_matrix (); - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = arg.double_value (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = d; - } - else - { - retval.resize (2); - retval(0) = 1.0; - retval(1) = d; - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = arg.complex_value (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = c; - } - else - { - retval.resize (2); - retval(0) = 1.0; - retval(1) = c; - } - } - break; - default: - panic_impossible (); - break; + if (nargout == 0 || nargout == 1) + { + retval(0) = result.schur_matrix (); + } + else + { + retval(1) = result.schur_matrix (); + retval(0) = result.unitary_matrix (); + } + } + else if (arg.is_real_scalar ()) + { + double d = arg.double_value (); + if (nargout == 0 || nargout == 1) + { + retval(0) = d; + } + else + { + retval(1) = d; + retval(0) = 1.0; + } + } + else if (arg.is_complex_scalar ()) + { + Complex c = arg.complex_value (); + if (nargout == 0 || nargout == 1) + { + retval(0) = c; + } + else + { + retval(1) = c; + retval(0) = 1.0; + } + } + else + { + gripe_wrong_type_arg ("schur", arg); } return retval;
--- a/src/sort.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/sort.cc Tue Aug 16 04:36:32 1994 +0000 @@ -184,83 +184,77 @@ else retval.resize (1); - switch (args(1).const_type ()) + tree_constant tmp = args(1); + + if (tmp.is_real_scalar ()) + { + retval(0) = tmp.double_value (); + if (return_idx) + retval(1) = 1.0; + } + else if (tmp.is_complex_scalar ()) + { + retval(0) = tmp.complex_value (); + if (return_idx) + retval(1) = 1.0; + } + else if (tmp.is_real_matrix () || tmp.is_string () || tmp.is_range ()) { - case tree_constant_rep::scalar_constant: - { - retval(0) = args(1).double_value (); - if (return_idx) - retval(1) = 1.0; - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = args(1).complex_value (); - if (return_idx) - retval(1) = 1.0; - } - break; - case tree_constant_rep::string_constant: - case tree_constant_rep::range_constant: - case tree_constant_rep::matrix_constant: - { - Matrix m = args(1).to_matrix (); - if (m.rows () == 1) - { - int nc = m.columns (); - RowVector v (nc); - for (int i = 0; i < nc; i++) - v.elem (i) = m.elem (0, i); - RowVector idx; - mx_sort (v, idx, return_idx); + Matrix m = tmp.to_matrix (); + if (m.rows () == 1) + { + int nc = m.columns (); + RowVector v (nc); + for (int i = 0; i < nc; i++) + v.elem (i) = m.elem (0, i); + RowVector idx; + mx_sort (v, idx, return_idx); - retval(0) = tree_constant (v, 0); - if (return_idx) - retval(1) = tree_constant (idx, 0); - } - else - { + retval(0) = tree_constant (v, 0); + if (return_idx) + retval(1) = tree_constant (idx, 0); + } + else + { // Sorts m in place, optionally computes index Matrix. - Matrix idx; - mx_sort (m, idx, return_idx); + Matrix idx; + mx_sort (m, idx, return_idx); - retval(0) = m; - if (return_idx) - retval(1) = idx; - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix cm = args(1).complex_matrix_value (); - if (cm.rows () == 1) - { - int nc = cm.columns (); - ComplexRowVector cv (nc); - for (int i = 0; i < nc; i++) - cv.elem (i) = cm.elem (0, i); - RowVector idx; - mx_sort (cv, idx, return_idx); + retval(0) = m; + if (return_idx) + retval(1) = idx; + } + } + else if (tmp.is_complex_matrix ()) + { + ComplexMatrix cm = tmp.complex_matrix_value (); + if (cm.rows () == 1) + { + int nc = cm.columns (); + ComplexRowVector cv (nc); + for (int i = 0; i < nc; i++) + cv.elem (i) = cm.elem (0, i); + RowVector idx; + mx_sort (cv, idx, return_idx); - retval(0) = tree_constant (cv, 0); - if (return_idx) - retval(1) = tree_constant (idx, 0); - } - else - { + retval(0) = tree_constant (cv, 0); + if (return_idx) + retval(1) = tree_constant (idx, 0); + } + else + { // Sorts cm in place, optionally computes index Matrix. - Matrix idx; - mx_sort (cm, idx, return_idx); + Matrix idx; + mx_sort (cm, idx, return_idx); - retval(0) = cm; - if (return_idx) - retval(1) = idx; - } - } - break; - default: - panic_impossible (); - break; + retval(0) = cm; + if (return_idx) + retval(1) = idx; + } + } + else + { + gripe_wrong_type_arg ("sort", tmp); } return retval;
--- a/src/svd.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/svd.cc Tue Aug 16 04:36:32 1994 +0000 @@ -54,6 +54,9 @@ tree_constant arg = args(1).make_numeric (); + if (error_state) + return retval; + if (arg.rows () == 0 || arg.columns () == 0) { int flag = user_pref.propagate_empty_matrices; @@ -63,10 +66,7 @@ gripe_empty_arg ("svd", 0); Matrix m; - retval.resize (3); - retval(0) = m; - retval(1) = m; - retval(2) = m; + retval.resize (3, m); } else gripe_empty_arg ("svd", 1); @@ -74,78 +74,50 @@ return retval; } - Matrix tmp; - ComplexMatrix ctmp; - switch (arg.const_type ()) - { - case tree_constant_rep::scalar_constant: - tmp.resize (1, 1); - tmp.elem (0, 0) = arg.double_value (); - break; - case tree_constant_rep::matrix_constant: - tmp = arg.matrix_value (); - break; - case tree_constant_rep::complex_scalar_constant: - ctmp.resize (1, 1); - ctmp.elem (0, 0) = arg.complex_value (); - break; - case tree_constant_rep::complex_matrix_constant: - ctmp = arg.complex_matrix_value (); - break; - default: - panic_impossible (); - break; - } - SVD::type type = (nargin == 3) ? SVD::economy : SVD::std; - switch (arg.const_type ()) + if (arg.is_real_type ()) { - case tree_constant_rep::scalar_constant: - case tree_constant_rep::matrix_constant: - { - SVD result (tmp, type); + Matrix tmp = arg.matrix_value (); - DiagMatrix sigma = result.singular_values (); + SVD result (tmp, type); + + DiagMatrix sigma = result.singular_values (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = tree_constant (sigma.diag (), 1); - } - else - { - retval.resize (3); - retval(0) = result.left_singular_matrix (); - retval(1) = sigma; - retval(2) = result.right_singular_matrix (); - } - } - break; - case tree_constant_rep::complex_scalar_constant: - case tree_constant_rep::complex_matrix_constant: - { - ComplexSVD result (ctmp, type); + if (nargout == 0 || nargout == 1) + { + retval(0) = tree_constant (sigma.diag (), 1); + } + else + { + retval(2) = result.right_singular_matrix (); + retval(1) = sigma; + retval(0) = result.left_singular_matrix (); + } + } + else if (arg.is_complex_type ()) + { + ComplexMatrix ctmp = arg.complex_matrix_value (); + + ComplexSVD result (ctmp, type); - DiagMatrix sigma = result.singular_values (); + DiagMatrix sigma = result.singular_values (); - if (nargout == 0 || nargout == 1) - { - retval.resize (1); - retval(0) = tree_constant (sigma.diag (), 1); - } - else - { - retval.resize (3); - retval(0) = result.left_singular_matrix (); - retval(1) = sigma; - retval(2) = result.right_singular_matrix (); - } - } - break; - default: - panic_impossible (); - break; + if (nargout == 0 || nargout == 1) + { + retval(0) = tree_constant (sigma.diag (), 1); + } + else + { + retval(2) = result.right_singular_matrix (); + retval(1) = sigma; + retval(0) = result.left_singular_matrix (); + } + } + else + { + gripe_wrong_type_arg ("svd", arg); + return retval; } return retval;
--- a/src/symtab.cc Mon Aug 15 04:54:33 1994 +0000 +++ b/src/symtab.cc Tue Aug 16 04:36:32 1994 +0000 @@ -679,29 +679,18 @@ { // Would be nice to avoid this cast. XXX FIXME XXX tree_constant *tmp = (tree_constant *) sr.def (); - switch (tmp->const_type ()) - { - case tree_constant_rep::scalar_constant: - const_type = SR_INFO_SCALAR; - break; - case tree_constant_rep::complex_scalar_constant: - const_type = SR_INFO_COMPLEX_SCALAR; - break; - case tree_constant_rep::matrix_constant: - const_type = SR_INFO_MATRIX; - break; - case tree_constant_rep::complex_matrix_constant: - const_type = SR_INFO_COMPLEX_MATRIX; - break; - case tree_constant_rep::range_constant: - const_type = SR_INFO_RANGE; - break; - case tree_constant_rep::string_constant: - const_type = SR_INFO_STRING; - break; - default: - break; - } + if (tmp->is_real_scalar ()) + const_type = SR_INFO_SCALAR; + else if (tmp->is_complex_scalar ()) + const_type = SR_INFO_COMPLEX_SCALAR; + else if (tmp->is_real_matrix ()) + const_type = SR_INFO_MATRIX; + else if (tmp->is_complex_matrix ()) + const_type = SR_INFO_COMPLEX_MATRIX; + else if (tmp->is_range ()) + const_type = SR_INFO_RANGE; + else if (tmp->is_string ()) + const_type = SR_INFO_STRING; nr = tmp->rows (); nc = tmp->columns ();
--- a/src/tc-rep.h Mon Aug 15 04:54:33 1994 +0000 +++ b/src/tc-rep.h Tue Aug 16 04:36:32 1994 +0000 @@ -24,26 +24,6 @@ #if !defined (octave_tree_const_rep_h) #define octave_tree_const_rep_h 1 -#if defined (__GNUG__) -#pragma interface -#endif - -#include <stdlib.h> - -#include "tree-base.h" - -#include "mx-base.h" -#include "Range.h" - -class idx_vector; - -struct Mapper_fcn; - -// Forward class declarations. - -class tree; -class tree_constant; - // The actual representation of the tree_constant. class @@ -51,7 +31,8 @@ { friend class tree_constant; -public: +private: + enum constant_type { unknown_constant, @@ -71,7 +52,6 @@ column_orient, }; -private: tree_constant_rep (void); tree_constant_rep (double d); @@ -102,23 +82,22 @@ void operator delete (void *p, size_t size); #endif - void resize (int i, int j); - void resize (int i, int j, double val); + int rows (void) const; + int columns (void) const; - void maybe_resize (int imax, force_orient fo = no_orient); - void maybe_resize (int imax, int jmax); + int is_defined (void) const + { return type_tag != tree_constant_rep::unknown_constant; } - int valid_as_scalar_index (void) const; - -// What type of constant am I? + int is_undefined (void) const + { return type_tag == tree_constant_rep::unknown_constant; } int is_unknown (void) const { return type_tag == tree_constant_rep::unknown_constant; } - int is_scalar (void) const + int is_real_scalar (void) const { return type_tag == tree_constant_rep::scalar_constant; } - int is_matrix (void) const + int is_real_matrix (void) const { return type_tag == tree_constant_rep::matrix_constant; } int is_complex_scalar (void) const @@ -133,14 +112,11 @@ int is_range (void) const { return type_tag == tree_constant_rep::range_constant; } -// Others tests, some more general, some just old names for the things -// above. + int is_magic_colon (void) const + { return type_tag == tree_constant_rep::magic_colon; } - int is_defined (void) const - { return type_tag != tree_constant_rep::unknown_constant; } - - int is_undefined (void) const - { return type_tag == tree_constant_rep::unknown_constant; } + tree_constant all (void) const; + tree_constant any (void) const; int is_scalar_type (void) const { return type_tag == scalar_constant @@ -159,7 +135,6 @@ { return type_tag == complex_matrix_constant || type_tag == complex_scalar_constant; } - int is_numeric_type (void) const { return type_tag == scalar_constant || type_tag == matrix_constant @@ -173,14 +148,84 @@ || type_tag == complex_scalar_constant || type_tag == range_constant; } - double to_scalar (void) const; - ColumnVector to_vector (void) const; - Matrix to_matrix (void) const; + int valid_as_scalar_index (void) const; + + int is_true (void) const; + + double double_value (void) const; + Matrix matrix_value (void) const; + Complex complex_value (void) const; + ComplexMatrix complex_matrix_value (void) const; + char *string_value (void) const; + Range range_value (void) const; + + tree_constant convert_to_str (void); + + void convert_to_row_or_column_vector (void); + + void force_numeric (int force_str_conv = 0); + tree_constant make_numeric (int force_str_conv = 0) const; + + void bump_value (tree_expression::type); + + void resize (int i, int j); + void resize (int i, int j, double val); + + void maybe_resize (int imax, force_orient fo = no_orient); + void maybe_resize (int imax, int jmax); void stash_original_text (char *s); - tree_constant_rep::constant_type force_numeric (int force_str_conv = 0); - tree_constant make_numeric (int force_str_conv = 0) const; +// Indexing. + + tree_constant do_index (const Octave_object& args); + + tree_constant do_scalar_index (const Octave_object& args) const; + + tree_constant do_matrix_index (const Octave_object& args) const; + + tree_constant do_matrix_index (const tree_constant& i_arg) const; + + tree_constant do_matrix_index (const tree_constant& i_arg, + const tree_constant& j_arg) const; + + tree_constant do_matrix_index (constant_type i) const; + + tree_constant fortran_style_matrix_index (const tree_constant& i_arg) const; + tree_constant fortran_style_matrix_index (const Matrix& mi) const; + + tree_constant do_vector_index (const tree_constant& i_arg) const; + + tree_constant do_matrix_index (int i, const tree_constant& i_arg) const; + tree_constant do_matrix_index (const idx_vector& i, + const tree_constant& i_arg) const; + tree_constant do_matrix_index (const Range& i, + const tree_constant& i_arg) const; + tree_constant do_matrix_index (constant_type i, + const tree_constant& i_arg) const; + + tree_constant do_matrix_index (int i, int j) const; + tree_constant do_matrix_index (int i, const idx_vector& j) const; + tree_constant do_matrix_index (int i, const Range& j) const; + tree_constant do_matrix_index (int i, constant_type cj) const; + + tree_constant do_matrix_index (const idx_vector& i, int j) const; + tree_constant do_matrix_index (const idx_vector& i, + const idx_vector& j) const; + tree_constant do_matrix_index (const idx_vector& i, const Range& j) const; + tree_constant do_matrix_index (const idx_vector& i, constant_type j) const; + + tree_constant do_matrix_index (const Range& i, int j) const; + tree_constant do_matrix_index (const Range& i, const idx_vector& j) const; + tree_constant do_matrix_index (const Range& i, const Range& j) const; + tree_constant do_matrix_index (const Range& i, constant_type j) const; + + tree_constant do_matrix_index (constant_type i, int j) const; + tree_constant do_matrix_index (constant_type i, const idx_vector& j) const; + tree_constant do_matrix_index (constant_type i, const Range& j) const; + tree_constant do_matrix_index (constant_type i, constant_type j) const; + +// Assignment. void assign (const tree_constant& rhs, const Octave_object& args); @@ -264,92 +309,21 @@ void delete_columns (idx_vector& j); void delete_columns (Range& j); - void bump_value (tree_expression::type); + void maybe_mutate (void); - void maybe_mutate (void); void print (void); void print_code (ostream& os); - tree_constant do_index (const Octave_object& args); - - tree_constant do_scalar_index (const Octave_object& args) const; - - tree_constant do_matrix_index (const Octave_object& args) const; - - tree_constant do_matrix_index (const tree_constant& i_arg) const; - - tree_constant do_matrix_index (const tree_constant& i_arg, - const tree_constant& j_arg) const; - - tree_constant do_matrix_index (constant_type i) const; - - tree_constant fortran_style_matrix_index (const tree_constant& i_arg) const; - tree_constant fortran_style_matrix_index (const Matrix& mi) const; - - tree_constant do_vector_index (const tree_constant& i_arg) const; +// Binary and unary operations. - tree_constant do_matrix_index (int i, const tree_constant& i_arg) const; - tree_constant do_matrix_index (const idx_vector& i, - const tree_constant& i_arg) const; - tree_constant do_matrix_index (const Range& i, - const tree_constant& i_arg) const; - tree_constant do_matrix_index (constant_type i, - const tree_constant& i_arg) const; - - tree_constant do_matrix_index (int i, int j) const; - tree_constant do_matrix_index (int i, const idx_vector& j) const; - tree_constant do_matrix_index (int i, const Range& j) const; - tree_constant do_matrix_index (int i, constant_type cj) const; - - tree_constant do_matrix_index (const idx_vector& i, int j) const; - tree_constant do_matrix_index (const idx_vector& i, - const idx_vector& j) const; - tree_constant do_matrix_index (const idx_vector& i, const Range& j) const; - tree_constant do_matrix_index (const idx_vector& i, constant_type j) const; + friend tree_constant do_binary_op (tree_constant& a, tree_constant& b, + tree_expression::type t); - tree_constant do_matrix_index (const Range& i, int j) const; - tree_constant do_matrix_index (const Range& i, const idx_vector& j) const; - tree_constant do_matrix_index (const Range& i, const Range& j) const; - tree_constant do_matrix_index (const Range& i, constant_type j) const; - - tree_constant do_matrix_index (constant_type i, int j) const; - tree_constant do_matrix_index (constant_type i, const idx_vector& j) const; - tree_constant do_matrix_index (constant_type i, const Range& j) const; - tree_constant do_matrix_index (constant_type i, constant_type j) const; - - double double_value (void) const; - Matrix matrix_value (void) const; - Complex complex_value (void) const; - ComplexMatrix complex_matrix_value (void) const; - char *string_value (void) const; - Range range_value (void) const; - - int rows (void) const; - int columns (void) const; + friend tree_constant do_unary_op (tree_constant& a, + tree_expression::type t); - tree_constant all (void) const; - tree_constant any (void) const; - tree_constant isstr (void) const; - - tree_constant convert_to_str (void); - - void convert_to_row_or_column_vector (void); - - int is_true (void) const; - - tree_constant cumprod (void) const; - tree_constant cumsum (void) const; - tree_constant prod (void) const; - tree_constant sum (void) const; - tree_constant sumsq (void) const; - - tree_constant diag (void) const; - tree_constant diag (const tree_constant& a) const; - - constant_type const_type (void) const { return type_tag; } - - tree_constant mapper (Mapper_fcn& m_fcn, int print) const; +// Data. int count; constant_type type_tag; @@ -363,13 +337,36 @@ Range *range; // A set of evenly spaced values. }; char *orig_text; -}; + +// ------------------------------------------------------------------- + +// These may not need to be member functions. + + tree_constant cumprod (void) const; + tree_constant cumsum (void) const; + tree_constant prod (void) const; + tree_constant sum (void) const; + tree_constant sumsq (void) const; + + tree_constant diag (void) const; + tree_constant diag (const tree_constant& a) const; -extern tree_constant do_binary_op (tree_constant& a, tree_constant& b, - tree_expression::type t); + tree_constant mapper (Mapper_fcn& m_fcn, int print) const; + +// ------------------------------------------------------------------- + +// We want to eliminate this. + + constant_type const_type (void) const { return type_tag; } -extern tree_constant do_unary_op (tree_constant& a, - tree_expression::type t); +// More conversions. These should probably be eliminated. 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. + + double to_scalar (void) const; + ColumnVector to_vector (void) const; + Matrix to_matrix (void) const; +}; #endif